#include "def.h"
#include "macro.h"
/* AK 141086 */
/* symchar.c */

static struct symchar * callocsymchar();
static INT calculate();
static INT removestrip();
static INT addstrip();
static INT removestrip_char();
static INT addstrip_char();
static INT stripexistp();
static INT stripexistp_char();
static INT (*sef)() = NULL, (*asf)() = NULL, (*rsf)() = NULL;

#ifdef CHARTRUE
INT augpart(part) OP part;
/* bsp: 1113 --> 1236 */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i;
	C_O_K(part,AUG_PART);
	for (i=(INT)0;i<S_PA_LI(part); i++)
		C_I_I(S_PA_I(part,i),S_PA_II(part,i)+i);
	return OK;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
static INT stripexistp_char(part,length,i) OP part; register INT  length,i;
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
	{
	/* register INT j; */
	unsigned char *z = S_PA_CI(part,i);
	register INT h2;

	h2 = *z;

	for (; i>=(INT)0;i--,z--)
		if ( (*z + length) == h2) 
			return(FALSE);
	return(TRUE);
	}
#endif /* CHARTRUE */


#ifdef CHARTRUE
static INT stripexistp(part,length,i) OP part; register INT  length,i;
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
	{
	/* register INT j; */
	OP z = S_PA_I(part,i);
	register INT h2;

	h2 = S_I_I(z);

	for (; i>=(INT)0;i--,z--)
		if ( (S_I_I(z) + length) == h2) 
			return(FALSE);
	return(TRUE);
	}
#endif /* CHARTRUE */


#ifdef CHARTRUE
static INT addstrip_char(part,k,i,hi) OP part; register INT  k,hi,i;
/* part vom Typ CHARPARTITION */
{
	/* register INT l; */
	i=i-hi;
	/* in l wird angesetzt */
	while ((k--)>(INT)0)
		{
		if (i == S_PA_LI(part)-(INT)1)
			{
			S_PA_CII(part,i)=S_PA_CII(part,i)
				+(unsigned char)k+(unsigned char)1;
			goto addstripende; 
			}
		else if (S_PA_CII(part,i) < S_PA_CII(part,(i+(INT)1)))
			S_PA_CII(part,i)++;
		else if (S_PA_CII(part,i) == S_PA_CII(part,(i+(INT)1)))
			S_PA_CII(part,++i)++;
		else
			error("addstrip_char:");
		}
addstripende:
	return OK;
}
#endif /* CHARTRUE */


#ifdef CHARTRUE
static INT addstrip(part,k,i,hi) OP part; register INT  k,hi,i;
{
	/* register INT l; */
	i=i-hi;
	/* in l wird angesetzt */
	while ((k--)>(INT)0)
		{
		if (i == S_PA_LI(part)-(INT)1)
			{
			M_I_I(S_PA_II(part,i)+k+(INT)1, S_PA_I(part,i));
			goto addstripende; 
			}
		else if (S_PA_II(part,i) < S_PA_II(part,(i+(INT)1)))
			INC_INTEGER(S_PA_I(part,i));
		else if (S_PA_II(part,i) == S_PA_II(part,(i+(INT)1)))
			INC_INTEGER(S_PA_I(part,++i));
		else
			error("addstrip:");
		}
addstripende:
	return OK;
}
#endif /* CHARTRUE */


#ifdef CHARTRUE
static INT removestrip_char(part,k,i) OP part; register INT  k; INT i;
/* erzeugt neue partition part in der ab der zeile i ein
streifen der laenge length entfernt wurde .
ergebnis ist die hakenlaenge */
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
	{
	register INT l;
	l=i;
	while ((k--)>(INT)0)
		{
		if (i == (INT)0) 
			S_PA_CII(part,(INT)0)--;
		else if (S_PA_CII(part,i) > S_PA_CII(part,(i-(INT)1)))
			S_PA_CII(part,i)--;
		else 	
			S_PA_CII(part,--i)--;
		};
	return(l-i);
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
static INT removestrip(part,k,i) OP part; register INT  k; INT i;
/* erzeugt neue partition part in der ab der zeile i ein
streifen der laenge length entfernt wurde .
ergebnis ist die hakenlaenge */
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
	{
	register INT l;
	l=i;
	while ((k--)>(INT)0)
		{
		if (i == (INT)0) 
			DEC_INTEGER(S_PA_I(part,(INT)0));
		else if (S_PA_II(part,i) > S_PA_II(part,(i-(INT)1)))
			DEC_INTEGER(S_PA_I(part,i));
		else 	
			DEC_INTEGER(S_PA_I(part,--i));
		};
	return(l-i);
	}
#endif /* CHARTRUE */
#define REMOVESTRIP(part,length,j)\
	k=length;l=j;m=j;\
	while ((k--)>(INT)0)\
		{\
		if (m == (INT)0) \
			DEC_INTEGER(S_PA_I((part),(INT)0));\
		else if (S_PA_II((part),m) > S_PA_II((part),(m-(INT)1)))\
			DEC_INTEGER(S_PA_I((part),m));\
		else 	\
			DEC_INTEGER(S_PA_I((part),--m));\
		};\
	hooklength=l-m;

#ifdef CHARTRUE
static INT calculate(sign,rep,part,res) INT  sign; OP part, res, rep;
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 250291 V1.2 */
/* AK 200891 V1.3 */
	{
	INT i,hooklength,k,l,m;
	OP newrep;
	INT erg=OK; 
        INT (*lsef)() = sef, (*lasf)() = asf, (*lrsf)() = rsf;

	if (S_PA_LI(part) == (INT)0)
		{ 
		if (sign==(INT)1) 
			erg += inc(res); 
		else if (sign == -1L) 
			erg += dec(res);
		else 
			erg += ERROR;
		return erg;
		};
	if (S_PA_LI(part) == 1L) /* Robinson Lemma 4.11 */
		{
		if (S_PA_LI(rep) == 1L)
				return M_I_I(1L,res);
		if (S_PA_II(rep,S_PA_LI(rep)-2L) > S_PA_LI(rep)-1L )
				return OK;
		/* rep is haken */
		for (i=(INT)0;i<S_PA_LI(rep);i++)
			if (S_PA_II(rep,i) > i) break;
		i = S_PA_LI(rep)-i;
		/* i is laenge der part */
		if (sign==1L)
			if (i % 2L == (INT)0)
				return dec(res);
			else 
				return inc(res);
		else
			if (i % 2L == (INT)0)
				return inc(res);
			else 
				return dec(res);
		}
	if (S_PA_II(part,S_PA_LI(part)-1) == 1L)
		/* AK 150988 */ /* dimension */
		{ 
		newrep = callocobject();
		erg += dimension_augpart(rep,newrep);
		if (sign == -1L) 
			erg += addinvers_apply(newrep);
		erg += add_apply(newrep,res); 
		erg += SYMfreeall(newrep); 
		return erg;
		}
	l = S_PA_LI(part)-1L; /* AK 040293 */
	for (i=S_PA_LI(rep)-1L;i>=(INT)0;i--)
	if (S_PA_II(part,l) <= S_PA_II(rep,i))
		if 	((*lsef)( rep, S_PA_II(part,l), i))
		
			{ 
			hooklength = (*lrsf)( rep, S_PA_II(part,l), i); 
			if (S_O_K(part) == PARTITION)
				erg += DEC_INTEGER(S_PA_L(part));
			else if (S_O_K(part) == CHARPARTITION) /* AK 130593 */
				S_PA_C(part)[0]--;
			erg += calculate( ((hooklength % 2L == (INT)0) ? 
					sign : - sign),
				rep, part, res); 
			if (S_O_K(part) == PARTITION) /* AK 130593 */
				erg += INC_INTEGER(S_PA_L(part));
			else if (S_O_K(part) == CHARPARTITION)
				S_PA_C(part)[0]++;
			erg += (*lasf)(rep, S_PA_II(part,l), i,hooklength);
		};
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT charvalue_tafel_part(rep,part,res,tafel,pv)	OP part,rep,res,tafel,pv;
/* AK 260690 V1.1 */ /* AK 250291 V1.2 */
/* tafel ist charactertafel, pv ist vector der partitionen */
/* AK 200891 V1.3 */
	{
	INT i,j,k;
	INT erg = OK;
	for (k=(INT)0; k<= S_V_LI(pv); k++)
		if (EQ(rep,S_V_I(pv,k))) {i=k; break; }
	for (k=(INT)0; k<= S_V_LI(pv); k++)
		if (EQ(part,S_V_I(pv,k))) {j=k; break; }
	erg += copy(S_M_IJ(tafel,i,j),res); 
	ENDR("charvalue_tafel_part");
	}
#endif /*CHARTRUE*/
	
INT charvalue(rep,part,res,tafel) OP part, rep, res; OP tafel;
/* tafel ist zeiger auf charactertafel mit werten, sonst NULL AK 130189  */
/* part ist der zykeltyp  oder eine PERMUTATION */
/* rep ist irr. darstellung */
/* AK 140789 V1.0 */ /* AK 080290 V1.1 */ /* AK 050391 V1.2 */
/* AK 200891 V1.3 */
	{	
#ifdef CHARTRUE
	OP newrep;
	INT erg=OK,i;
	if (S_O_K(rep) == SKEWPARTITION) /* AK 170392 */
		{
	return error("charvalue:rep == SKEWPARTITION not yet implemented");
		}

	if (S_O_K(part) == PERMUTATION)
		{ 
		OP newpart = callocobject(); 
		erg += zykeltyp(part,newpart); 
		erg += charvalue(rep,newpart,res,tafel);
		erg += SYMfreeall(newpart); 
		return erg;
		}
	if (tafel != NULL)
		{ 
		INT i = indexofpart(rep), 
		    j = indexofpart(part);
		if (S_O_K(tafel) != MATRIX)
			error("charvalue:tafel !=  MATRIX");
		erg += copy(S_M_IJ(tafel,i,j),res); 
		return erg;
		}
	if (S_PA_II(part,S_PA_LI(part)-1L) == 1L)
		/* es wird die dimension berechnet */
		{ 
		erg += dimension_partition(rep,res); 
		return erg;
		};


	if (rep == part)
		{
		newrep = callocobject();
		erg += copy(rep,newrep);
		erg += charvalue(newrep,part,res,NULL);
		erg += SYMfreeall(newrep);
		return erg;
		}

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


	if (S_O_K(rep) == PARTITION)
		erg += c_PARTITION_AUGPART(rep);
	else if (S_O_K(rep) == CHARPARTITION)
		erg += c_CHARPARTITION_CHARAUGPART(rep);

	if (S_O_K(rep) == AUG_PART) 
		{
		sef = stripexistp;
		asf = addstrip;
		rsf = removestrip;
		}
	if (S_O_K(rep) == CHAR_AUG_PART) 
		{
		sef = stripexistp_char;
		asf = addstrip_char;
		rsf = removestrip_char;
		}

	erg += M_I_I((INT)0,res); 
	erg += calculate(1L,rep,part,res);

	if (S_O_K(rep) == AUG_PART)
		erg += c_AUGPART_PARTITION(rep);
	else if (S_O_K(rep) == CHAR_AUG_PART)
		erg += c_CHARAUGPART_CHARPARTITION(rep);
/*
	for (i=(INT)0;i<S_PA_LI(rep);i++)
		M_I_I(S_PA_II(rep,i)-i, S_PA_I(rep,i));
	C_O_K(rep,PARTITION);
*/
	if (erg != OK)
		EDC("charvalue");
	return erg;
#endif /* CHARTRUE */
	}
	
	

#ifdef CHARTRUE
INT chartafel_partvector(a,erg,pv) OP a; OP erg,pv;
/* AK 260690 V1.1 */ /* AK 200891 V1.3 */
	{
	return chartafel(a,erg);
	}
#endif /* CHARTRUE */

#ifdef MATRIXTRUE
#ifdef CHARTRUE
INT chartafel(a,b) OP a,b;
{
	return chartafel_nonbit(a,b);
}

INT chartafel_bit(a,res) OP a; OP res;
/* AK 161294 */
	{
	OP conjpart = callocobject();  /* AK 290888 */
	OP vec = callocobject();
	OP bitvec = callocobject();
	INT dim; /* 231187 AK dimension der matrix */
	INT i,j;
	INT index;
	INT vi;
	INT erg = OK;

	erg += makevectorofpart(a,vec);
	dim = S_V_LI(vec);
	erg += m_il_v(dim,bitvec);
	for (i=0L;i<dim;i++)
		t_VECTOR_BIT(S_V_I(vec,i),S_V_I(bitvec,i));

	erg += m_ilih_m(dim,dim,res);

	i = dim-1L; j=(INT)0;
	do	{ 
		erg += charvalue_bit(S_V_I(bitvec,i),S_V_I(vec,j),
			S_M_IJ(res,S_M_HI(res)-1L,j),NULL);
		j++; } 
	while( j < dim);
	/* das war der alternierende Character */

	for (j=(INT)0;j<S_M_LI(res);j++) 
		M_I_I(1L,S_M_IJ(res,(INT)0,j));
	/* das war der eins - Character */

	i=(INT)0;
	do	{
		if (EMPTYP(S_M_IJ(res,i,(INT)0))) 
			/* d.h. zeile noch nicht berechnet */
			{
			j=(INT)0;
			do	{ 
	if (  (		S_PA_LI(S_V_I(vec,i))   /* vgl JK Cor 2.4.9 */
			-1L
			+S_PA_II(S_V_I(vec,i),S_PA_LI(S_V_I(vec,i))-1L) 
		)
		>= 
		(	S_PA_II(S_V_I(vec,j),S_PA_LI(S_V_I(vec,j))-1L)  )
          )
				erg += charvalue_bit(S_V_I(bitvec,i),S_V_I(vec,j),
					S_M_IJ(res,i,j),NULL);
	else
			M_I_I((INT)0,S_M_IJ(res,i,j));
				j++;
				}
			while( j < dim);
			/* AK 290888 berechnung des assozierten characters */
			conjugate(S_V_I(vec,i),conjpart);

			for (index = i+1L;index<dim;index ++) 
				if (EQ(conjpart,S_V_I(vec,index))) 
					break;
			
			if (index < dim) 
				for (j=(INT)0;j<S_M_LI(res);j++)
					erg += mult(	S_M_IJ(res,i,j),
						S_M_IJ(res,S_M_HI(res)-1L,j),
						S_M_IJ(res,index,j));
						/* character * 
						alternierender character */
			};
		i++;
		}
	while( i < dim);

	erg += SYMfreeall(conjpart); 
	erg += SYMfreeall(vec); 
	erg += SYMfreeall(bitvec); 
	ENDR("chartafel_bit");
	}

INT chartafel_nonbit(a,res) OP a; OP res;
/* AK 221187 ergebnis ist vom typ matrix*/
/* AK 240387 */ /* berechnet chartafel der s-a aus */
/* AK 170789 V1.0 */ /* AK 080290 V1.1 */ /* AK 200891 V1.3 */
	{
	OP conjpart = callocobject();  /* AK 290888 */
	OP vec = callocobject();
	INT dim; /* 231187 AK dimension der matrix */
	INT i,j;
	INT index;
	INT vi;
	INT erg = OK;

	erg += makevectorofpart(a,vec);
	dim = S_V_LI(vec);
	erg += m_ilih_m(dim,dim,res); /* AK 231187 res ist damit initialisiert */	

	i = dim-1L; j=(INT)0;
	do	{ 
		erg += charvalue(S_V_I(vec,i),S_V_I(vec,j),
			S_M_IJ(res,S_M_HI(res)-1L,j),NULL);
		j++; } 
	while( j < dim);
	/* das war der alternierende Character */

	for (j=(INT)0;j<S_M_LI(res);j++) 
		M_I_I(1L,S_M_IJ(res,(INT)0,j));
	/* das war der eins - Character */

	i=(INT)0;
	do	{
		if (EMPTYP(S_M_IJ(res,i,(INT)0))) 
			/* d.h. zeile noch nicht berechnet */
			{
			j=(INT)0;
			do	{ 
	if (  (		S_PA_LI(S_V_I(vec,i))   /* vgl JK Cor 2.4.9 */
			-1L
			+S_PA_II(S_V_I(vec,i),S_PA_LI(S_V_I(vec,i))-1L) 
		)
		>= 
		(	S_PA_II(S_V_I(vec,j),S_PA_LI(S_V_I(vec,j))-1L)  )
          )
				erg += charvalue(S_V_I(vec,i),S_V_I(vec,j),
					S_M_IJ(res,i,j),NULL);
	else
			M_I_I((INT)0,S_M_IJ(res,i,j));
				j++;
				}
			while( j < dim);
			/* AK 290888 berechnung des assozierten characters */
			conjugate(S_V_I(vec,i),conjpart);

			for (index = i+1L;index<dim;index ++) 
				if (EQ(conjpart,S_V_I(vec,index))) 
					break;
			
			if (index < dim) 
				for (j=(INT)0;j<S_M_LI(res);j++)
					erg += mult(	S_M_IJ(res,i,j),
						S_M_IJ(res,S_M_HI(res)-1L,j),
						S_M_IJ(res,index,j));
						/* character * 
						alternierender character */
			};
		i++;
		}
	while( i < dim);

	erg += SYMfreeall(conjpart); 
	erg += SYMfreeall(vec); 
	ENDR("chartafel_nonbit");
	}
#endif /* CHARTRUE */
#endif /* MATRIXTRUE */


INT c_i_n(mu,n,erg,tafel) OP mu,n,erg,tafel;
/* berechnet aus n INTEGER
mu PARTITION den wert c_mu,n =
Mittelwert der summe ueber die Werte des mu-ten
irreduziblen Charakters von den n-ten Potenzen der
x aus S_m, m= gewicht von mu */
/* AK 190988 */
/* AK wenn tafel != NULL ist dies ein zeiger auf die
zugehoerige charactertafel */
/* AK 200789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	OP m = callocobject(),ord=callocobject();  
	OP laufpart=callocobject(),exp=callocobject(); 
	OP zw=callocobject(),zwerg=callocobject(),hocherg=callocobject(); 
	weight(mu,m);
	first_partition(m,laufpart); /* vom typ VECTOR */
	freeself(erg);M_I_I((INT)0,erg); /* vorbesetzen mit 0 */

	do	{
		ordcon(laufpart,ord);
		t_VECTOR_EXPONENT(laufpart,exp);
		zykeltyp_hoch_n(exp,n,hocherg);
		t_EXPONENT_VECTOR(hocherg,zw);
		charvalue(mu,zw,zwerg,tafel);
		mult(zwerg,ord,zwerg);
		add(erg,zwerg,erg);
		}
	while(next(laufpart,laufpart));

	fakul(m,zwerg);
	div3(erg,zwerg,erg); /* noch durch gruppenordnung dividieren */

	SYMfreeall(m);SYMfreeall(zwerg);SYMfreeall(laufpart);SYMfreeall(ord);SYMfreeall(exp);
	SYMfreeall(hocherg);SYMfreeall(zw);
	return(OK);
#else
	error("c_i_n:SYMCHAR not available");return(ERROR);
#endif /* CHARTRUE */
	}


INT symchar_hoch_n(a,n,erg) OP a,n,erg;
/* der SYMCHAR a wird verallgemeinert zu a^n
d.h. die klasse alpha erhaelt den wert auf alpha hoch n */
/* AK 200988 */
/* AK 200789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	INT i,index;
	OP zw=callocobject(),zw2=callocobject(); 
	copy(a,erg);
	for (i=(INT)0;i<S_SC_WLI(erg);i++)
		{
		t_VECTOR_EXPONENT(S_SC_PI(erg,i),zw);
		zykeltyp_hoch_n(zw,n,zw2);
		freeself(zw);
		t_EXPONENT_VECTOR(zw2,zw);
		index=indexofpart(zw);
		copy(S_SC_WI(a,index),S_SC_WI(erg,i));
		freeself(zw); freeself(zw2);
		}
	return(OK);
#else
	error("symchar_hoch_n:SYMCHAR not available");return(ERROR);
#endif /* CHARTRUE */
	}

INT c_i_n_an(mu,n,erg,tafel) OP mu,n,erg,tafel;
/* berechnet aus n INTEGER
mu PARTITION den wert c_mu,n =
Mittelwert der summe ueber die Werte des mu-ten
irreduziblen Charakters von den n-ten Potenzen der
x aus S_m, m= gewicht von mu */
/* AK 190988 */
/* AK wenn tafel != NULL ist dies ein zeiger auf die
zugehoerige charactertafel */
/* AK 200789 V1.0 */ /* AK 260690 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	OP m = callocobject(),ord=callocobject();  
	OP laufpart=callocobject(),exp=callocobject(); 
	OP zw=callocobject(),zwerg=callocobject(),hocherg=callocobject(); 
	weight(mu,m);
	first_partition(m,laufpart); /* vom typ VECTOR */
	freeself(erg);M_I_I((INT)0,erg); /* vorbesetzen mit 0 */

	do	{
		if ((s_i_i(m) - s_pa_li(laufpart))%2 == 0) {
		ordcon(laufpart,ord);
		t_VECTOR_EXPONENT(laufpart,exp);
		zykeltyp_hoch_n(exp,n,hocherg);
		t_EXPONENT_VECTOR(hocherg,zw);
		charvalue(mu,zw,zwerg,tafel);
		mult(zwerg,ord,zwerg);
		add(erg,zwerg,erg);}
		}
	while(next(laufpart,laufpart));

	fakul(m,zwerg);
	div3(erg,zwerg,erg); /* noch durch gruppenordnung dividieren */
	freeself(zw);
	M_I_I(2L,zw);mult(erg,zw,erg);

	SYMfreeall(m);SYMfreeall(zwerg);SYMfreeall(laufpart);SYMfreeall(ord);SYMfreeall(exp);
	SYMfreeall(hocherg);SYMfreeall(zw); return(OK);
#else
	error("c_i_n_an:SYMCHAR not available");return(ERROR);
#endif /* CHARTRUE */
	}


INT m_part_centralsc(part,c) OP part,c;
/* AK 010888 curtis/reiner p.235 */
/* AK 140789 V1.0 */ /* AK 100191 V1.1 */ /* AK 220791 V1.3 */
	{
#ifdef CHARTRUE
	INT i,erg=OK;
	OP zw = callocobject(); 
	OP zw2 = callocobject(); 
	erg += m_part_sc(part,c); 
        erg += dimension(part,zw); /* fehler vorher ordcen */
	for (i=(INT)0; i<S_SC_PLI(c);i++)
		{ 
		erg += ordcon(S_SC_PI(c,i),zw2);
		erg += mult_apply(zw2,S_SC_WI(c,i)); 
		}
	erg += div3(c,zw,c); 
	erg += SYMfreeall(zw); 
	erg += SYMfreeall(zw2); 
	if (erg != OK) 
		EDC("m_part_centralsc");
	return erg;
#endif  /* CHARTRUE */
	}

INT m_part_sc(part,erg) OP part,erg; 
/* AK 200891 V1.3 */
	{
	return m_part_sc_tafel(part,erg,NULL);
	}

#ifdef CHARTRUE
INT m_part_sc_tafel(part,res,ct) OP part,res;OP ct;
/* den irreduziblen character zur partition part */
/* AK 140789 V1.0 */
/* AK 210690 V1.1 */ /* ct == NULL oder charactertafel */
/* AK 200891 V1.3 */
	{
	OP dim;
	INT i=(INT)0,j;
	INT erg = OK;

	if (S_O_K(part) != PARTITION) /* AK 041291 */
		return WTO(part,"m_part_sc_tafel");

	dim = callocobject();
	erg += weight(part,dim);
	erg += m_d_sc(dim,res);
	if (ct == NULL) {	
		for (i=(INT)0;i<S_SC_PLI(res);i++)
			erg += charvalue(part,S_SC_PI(res,i),
					S_SC_WI(res,i),NULL);
		}
	else	{
		j = indexofpart(part);
		for (i=(INT)0;i<S_SC_PLI(res);i++)
			erg += copy(S_M_IJ(ct,j,i),S_SC_WI(res,i));
		}
	erg += SYMfreeall(dim); /* AK 090893 */
	if (erg != OK)
		EDC("m_part_sc_tafel");
	return erg;
	}
#endif  /* CHARTRUE */


#ifdef CHARTRUE
INT ntopaar_symchar(a,b) OP a,b; /* sind symchar */
/* 280488 ohne representanten */
/* diese  routine berechnet den induzierten charcter
aus s_n in s_(n ueber 2) */
/* AK 170789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{ 
	OP dimb;
	OP perm = callocobject(); 
	OP grosseperm = callocobject(); 
	OP faktor = callocobject(); 
	OP typ = callocobject(); 
	OP ordnung = callocobject(); 
	OP ordnung2 = callocobject(); 
	OP help = callocobject(); 
	
	INT i,j,index, erg = OK;


	dimb=callocobject(); 
	M_I_I(2L,dimb);
	erg += binom(S_SC_D(a),dimb,dimb);
	/* dimb ist dimension von b */
	erg += m_d_sc(dimb,b);
	/* b ist nun initialisiert */
	
	erg += fakul(S_SC_D(b),help);
	erg += fakul(S_SC_D(a),faktor);
	erg += div3(help,faktor,faktor);	/* der konstante faktor */

	for (j=(INT)0;j<S_SC_PLI(a);j++) 
		/* dies ist eine schleife ueber alle
		konjugiertenklassen der unter-gruppe
		*/
		{
		if (not nullp(S_SC_WI(a,j)))
			{
			erg += m_part_perm(S_SC_PI(a,j),perm);
			erg += m_perm_paareperm(perm,grosseperm);
			erg += zykeltyp(grosseperm,typ);
			/* typ ist der zykeltyp der induzierten
			permutation */
			index=indexofpart(typ);
			erg += ordcon(S_SC_PI(a,j),ordnung);
			erg += ordcon(typ,ordnung2);
			erg += freeself(help);

			erg += mult(S_SC_WI(a,j) , ordnung,help);
			erg += mult(help,faktor,help);
			erg += div3(help, ordnung2,help);
			erg += add(help,S_SC_WI(b,index),S_SC_WI(b,index));
			}
		};

	erg += SYMfreeall(dimb);
	erg += SYMfreeall(help);
	erg += SYMfreeall(ordnung);
	erg += SYMfreeall(perm);
	erg += SYMfreeall(grosseperm);
	erg += SYMfreeall(faktor);
	erg += SYMfreeall(typ);
	erg += SYMfreeall(ordnung2);
	if (erg != OK)
		EDC("ntopaar_symchar");
	return erg;
	}
#endif /* CHARTRUE */

/* reduce_sc.c */
INT reduce_symchar(a,b) OP a,b; 
/* AK 200891 V1.3 */
	{
	return reduce_symchar_tafel(a,b,NULL);
	}

INT reduce_symchar_tafel(a,b,ct) OP a,b;OP ct;
/* a ist symchar , b ist wird schurfunktion */
/* AK 170789 V1.0 */
/* AK 030190 V1.1 */ /* AK 210690 ct==NULL oder charactertafel */
/* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
#ifdef SCHURTRUE
	INT i,dt = (INT)0;
	OP zw1=callocobject(),
	   erg=callocobject();
	if (not EMPTYP(b)) 
		freeself(b);

	for (i=(INT)0;i<S_SC_PLI(a);i++)
		{
		m_part_sc_tafel(S_SC_PI(a,i),zw1,ct);
		scalarproduct_symchar(zw1,a,erg);
		freeself(zw1);
		if (not nullp(erg))
			{ 
			OP zw = callocobject();
			b_skn_s(callocobject(),callocobject(),NULL,zw);
			copy(S_SC_PI(a,i),S_S_S(zw));
			copy(erg,S_S_K(zw));
			insert(zw,b,NULL,comp_monomvector_monomvector);
			}
		else	{
			}
		freeself(erg);
		};

	SYMfreeall(erg); 
	SYMfreeall(zw1); 
	return(OK);
#else 
	error("reduce_sc: SCHUR not available"); 
	return(ERROR);
#endif /* SCHURTRUE */
#endif /* CHARTRUE */
	}

/* scalar_prod.c */

#ifdef CHARTRUE
INT scalarproduct_symchar(a,b,c) OP a,b,c;
/* skalarproduct von a und b nach c */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i;
	OP zw,  zw2, invord;
	if (S_O_K(a) != SYMCHAR) /* AK 290692 */
		return error("scalarproduct_symchar: wrong type of a");
	if (S_O_K(b) != SYMCHAR) /* AK 290692 */
		return error("scalarproduct_symchar: wrong type of b");

	if (neq(S_SC_D(a), S_SC_D(b)))
		{
		error("scalarproduct_symchar: differnt degrees");
		return ERROR;
		}

	zw = callocobject();
	zw2 = callocobject();
	invord = callocobject();

	for (i=(INT)0;i<S_SC_PLI(a);i++)
		{
		mult(S_SC_WI(a,i),S_SC_WI(b,i),zw2);
		inversordcen(S_SC_PI(a,i),invord);
		mult(invord,zw2,zw);
		add(zw,c,c);
		freeself(zw);
		freeself(invord);
		};
	SYMfreeall(zw);
	SYMfreeall(invord);
	SYMfreeall(zw2);
	return(OK);
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT char_matrix_scalar_product(a,i,b,j,partvec,erg,convec) OP a,b,erg,partvec;
	INT i,j; OP convec;
/* AK Tue Jan 24 07:36:11 MEZ 1989 */
/* berechnet skalarproduct bei charactertafeln
dabei wird aus a zeile i und aus b zeile j verwendet 
partvec ist vectorofpartition zu den tafeln
AK 260189
convec ist wenn != NULL vector konjugiertenklassen ordnung */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT k;
	OP zw = callocobject(),zw2 = callocobject(), fak, hcv;


	if (neq (s_m_l(a),s_m_l(b)))
		error("char_matrix_scalar_product:different length of matrix");

	if (convec == NULL)
		{
		hcv = callocobject(); 
		m_il_v(S_V_LI(partvec),hcv);
		for (k=(INT)0;k<s_m_li(a);k++)
			ordcon(S_V_I(partvec,k),S_V_I(hcv,k));
		}
	else	hcv = convec;


	freeself(erg);
	M_I_I((INT)0,erg);

	for (k=(INT)0;k<S_M_LI(a);k++)
		{
		mult(S_M_IJ(a,i,k),S_M_IJ(b,j,k),zw2);
		mult(S_V_I(hcv,k),zw2,zw);
		add(zw,erg,erg);
		freeself(zw);
		};

	fak=callocobject(); 
	fakul(s_pa_i(S_V_I(partvec,(INT)0),(INT)0),fak);
	div3(erg,fak,erg);


	SYMfreeall(zw);
	SYMfreeall(fak);
	SYMfreeall(zw2);
	if (convec == NULL) SYMfreeall(hcv);
	return(OK);
	}
#endif  /* CHARTRUE */

#ifdef CHARTRUE
INT mult_apply_symchar(a,b) OP a,b;
/* a is SYMCHAR */
/* AK 050391 V1.2 */ /* AK 160891 V1.3 */
	{
	OP c;
	INT erg = OK;
	switch (S_O_K(b))
		{
		case SYMCHAR:
			erg += mult_apply(S_SC_W(a),S_SC_W(b));break;
		default: /* AK 160891 */
			c = callocobject();
			*c = *b;
			erg += C_O_K(b,EMPTY);
			erg += mult(a,c,b);
			erg += SYMfreeall(c);
			break;	
		}
	if (erg != OK)
		error("mult_apply_symchar: error during computation");
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT mult_symchar_symchar(a,b,c) OP a,b,c;
/* AK Wed Mar  8 10:32:46 MEZ 1989 */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	erg += copy(b,c);
	erg += mult(S_SC_W(a),S_SC_W(b),S_SC_W(c));
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT comp_symchar(a,b) OP a,b;
/* AK Thu Jan  3 14:53:38 MEZ 1991 */
/* AK 050391 V1.2 */ /* AK 200891 V1.3 */
{
	if (S_O_K(b) != SYMCHAR) 
		{
		error("comp_symchar: wrong second kind");
		return ERROR;
		}
	if ( neq( S_SC_D(a), S_SC_D(b) ) ) 
		{
		debugprint(S_SC_D(a));
		debugprint(S_SC_D(b));
		error("comp_symchar:  different degrees");
		return ERROR;
		}
	return 
		comp( S_SC_W(a), S_SC_W(b) );
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT mult_scalar_symchar(a,b,c) OP a,b,c; 
/* AK 010888 */
/* a skalar b symchar c wird symchar */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	erg += copy(b,c);
	erg += mult(a,S_SC_W(b),S_SC_W(c));
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT copy_symchar(a,b) OP a,b; 
/* AK 110588 */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg=OK;
	erg += b_wpd_sc(callocobject(),callocobject(),callocobject(),b);
	erg += copy(S_SC_D(a),S_SC_D(b));
	erg += copy(S_SC_P(a),S_SC_P(b));
	erg += copy(S_SC_W(a),S_SC_W(b));
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT reduce_inner_tensor_sc(a,b,c) OP a,b,c;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	OP d = callocobject(); 
	OP e = callocobject(); 
	OP f = callocobject(); 
	m_part_sc(a,d); m_part_sc(b,e); inner_tensor_sc(d,e,f);
	reduce_symchar(f,c); SYMfreeall(d); SYMfreeall(e); SYMfreeall(f);
	return(OK);
	}
#endif /* CHARTRUE */

INT inner_tensor_sc(a,b,c) OP a,b,c;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	if (neq(S_SC_D(a),S_SC_D(b))) {
		error("inner_tensor_sc:different degrees");
		return(ERROR);
		};

	copy(a,c);
	mult(S_SC_W(a),S_SC_W(b),S_SC_W(c));
	return(OK);
#endif /* CHARTRUE */
	}

#ifdef CHARTRUE
INT reduceninpaar(a,b) OP a,b;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	OP c = callocobject(); 
	OP d = callocobject(); 
	INT erg = OK;
	erg += m_part_sc(a,c); 
	erg += ntopaar_symchar(c,d);
	erg += reduce_symchar(d,b); 
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	if (erg != OK)
		EDC("reduceinpaar");
	return erg;
	}
#endif /* CHARTRUE */


#ifdef CHARTRUE
INT makevectorofshuffle(max,len,vec) OP max,len,vec;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i;
	INT erg = OK;

	erg += m_il_v(numberof_shufflepermutation(max,len),vec);
	erg += first_permutation(len,S_V_I(vec,(INT)0));
	for (i=1L;i<S_V_LI(vec);i++)
		next_shufflepermutation(max,S_V_I(vec,i-1),S_V_I(vec,i));
	return erg;
	}
#endif /* CHARTRUE */


#ifdef CHARTRUE
INT add_apply_symchar(a,b) OP a,b;
/* AK 250391 V1.2 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	CTO(SYMCHAR,"add_apply_symchar",b);
	erg += add_apply(S_SC_W(a),S_SC_W(b));
	ENDR("add_apply_symchar");
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT add_symchar(a,b,c) OP a,b,c;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	CTO(SYMCHAR,"add_symchar",b);
	erg += b_wpd_sc(callocobject(),callocobject(),callocobject(),c);
	erg += copy(S_SC_D(a),S_SC_D(c)); 	
	erg += copy(S_SC_P(a),S_SC_P(c));
	erg += add(S_SC_W(a),S_SC_W(b),S_SC_W(c));
	ENDR("add_symchar");
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT addinvers_apply_symchar(a) OP a;
/* AK 201289 V1.1 */ /* AK 200891 V1.3 */
	{
	return(addinvers_apply(S_SC_W(a)));
	}
#endif /* CHARTRUE */


INT addinvers_symchar(a,c) OP a,c;
/* AK 140789 V1.0 */ /* AK 201289 V1.1 */ /* AK 250391 V1.2 */
/* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	INT erg = OK;
	erg += b_wpd_sc(callocobject(),callocobject(),callocobject(),c);
	erg += copy(S_SC_D(a),S_SC_D(c)); 
	erg += copy(S_SC_P(a),S_SC_P(c));
	erg += addinvers(S_SC_W(a),S_SC_W(c));
	ENDR("addinvers_symchar");
#endif /* CHARTRUE */
	}


#ifdef CHARTRUE
INT freeself_symchar(a) OP a;
/* AK 140789 V1.0 */ /* AK 060290 V1.1 */ /* AK 250391 V1.2 */
/* AK 200891 V1.3 */
	{
	OBJECTSELF d;
	INT erg = OK;
	erg += SYMfreeall(S_SC_W(a)); 
	erg += SYMfreeall(S_SC_P(a)); 
	erg += SYMfreeall(S_SC_D(a));
	d = S_O_S(a);
	SYM_free(d.ob_symchar);
	C_O_K(a,EMPTY);
	if (erg != OK)
		EDC("freeself_symchar");
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT objectread_symchar(fp,a) FILE *fp; OP a;
/* AK 260291 V1.2 */ /* AK 200891 V1.3 */
	{
	INT erg =OK;
	erg += b_wpd_sc(callocobject(),callocobject(),callocobject(),a);
	erg += objectread(fp,S_SC_D(a));
	erg += objectread(fp,S_SC_P(a));
	erg += objectread(fp,S_SC_W(a));
	return erg;
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT objectwrite_symchar(fp,a) FILE *fp; OP a;
/* AK 260291 V1.2 */ /* AK 200891 V1.3 */
	{
	INT erg=OK;
	fprintf(fp,"%ld\n",(INT)SYMCHAR);
	erg += objectwrite(fp,S_SC_D(a));
	erg += objectwrite(fp,S_SC_P(a));
	erg += objectwrite(fp,S_SC_W(a));
	return erg;
	}
#endif /* CHARTRUE */

INT nullp_symchar(a) OP a;
/* AK 010692 */
	{
#ifdef CHARTRUE
	return nullp(S_SC_W(a));
#endif /* CHARTRUE */
	}

#ifdef CHARTRUE
INT tex_symchar(a) OP a;
/* AK 150692 */
	{
	return tex(S_SC_W(a));
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT einsp_symchar(a) OP a;
/* AK 010692 */
	{
	return einsp(S_SC_W(a));
	}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT fprint_symchar(fp,a) FILE *fp; OP a;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i;
	for (i=(INT)0; i<S_SC_WLI(a);i++)
		{
		fprint(fp,S_SC_PI(a,i)); fprintf(fp,":");
		fprint(fp,S_SC_WI(a,i)); fprintf(fp,",");
		if (fp == stdout)
			if (zeilenposition>(INT)70)
				{ zeilenposition = (INT)0; fprintf(fp,"\n"); }
			else 	zeilenposition += 2L;
		}
	return(OK);
	}
#endif /* CHARTRUE */

INT scan_symchar(a) OP a;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	OP dim = callocobject();
	INT i;
	extern INT zeilenposition;
	INT erg = OK;
	erg += printeingabe(" enter the degree of the group");
	erg += scan(INTEGER,dim); 
	erg += b_d_sc(dim,a);

	erg += printeingabe(" enter the character-value on the given class");
	for (i=(INT)0;i<S_SC_PLI(a);i++)
		{ 
		erg += print(S_SC_PI(a,i)); 
		printf(" "); 
		zeilenposition++;
		erg += scan(INTEGER,S_SC_WI(a,i)); 
		};
	if (erg != OK)
		error("scan_symchar: error during computation");
	return erg;
#endif /* CHARTRUE */
	}

INT m_d_sc(dim,ergebnis) OP dim,ergebnis;
/* AK 040391 V1.2 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	OP c = callocobject();
	INT erg = OK;
	erg += copy(dim,c);
	erg += b_d_sc(c,ergebnis);
	if (erg != OK)
		error("m_d_sc: error during computation");
	return erg;
#endif /* CHARTRUE */
	}

#ifdef CHARTRUE
INT b_d_sc(dim,ergebnis) OP dim,ergebnis;
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	INT i;
	INT erg = OK; /* AK 301091 */
	if (dim == ergebnis) /* AK 301091 */
		return error("b_d_sc:input and output are equal");
	if (not EMPTYP(ergebnis)) 
		erg += freeself(ergebnis);
	erg += b_wpd_sc(callocobject(),callocobject(),dim,ergebnis);
	erg += makevectorofpart(dim,S_SC_P(ergebnis));
	erg += m_il_nv(S_SC_PLI(ergebnis),S_SC_W(ergebnis));
	if (erg != OK)
		error("b_d_sc: error during computation");
	return erg;
	}
#endif /* CHARTRUE */


#ifdef CHARTRUE
static struct symchar * callocsymchar()
/* 110488 AK erste prozedur beim einfuehren eines neuen datentyps */
/* AK 140789 V1.0 */ /* AK 260790 V1.1 */ /* AK 200891 V1.3 */
	{
	struct  symchar *erg
	= (struct symchar *) SYM_calloc((int)1,sizeof(struct symchar));
	if (erg == NULL) 
		no_memory();
	return(erg);
	}
#endif /* CHARTRUE */

INT m_wpd_sc(wert,parlist,dim,ergebnis) OP wert,parlist,dim,ergebnis;
/* AK Fri Jan  4 09:25:43 MEZ 1991 */
/* AK 200891 V1.3 */
{
	b_wpd_sc(callocobject(),callocobject(),callocobject(),ergebnis);
	copy(wert, S_SC_W(ergebnis));
	copy(parlist, S_SC_P(ergebnis));
	copy(dim, S_SC_D(ergebnis));
	return OK;
}

INT b_wpd_sc(wert,parlist,dim,ergebnis) OP wert,parlist,dim,ergebnis;
/* die zweite prozedur bei neuen typen */
/* AK 110488 erzeugt aus der werteliste den symcharacter */
/* AK 140789 V1.0 */ /* AK 030190 V1.1 */ /* AK 200891 V1.3 */
	{
#ifdef CHARTRUE
	OBJECTSELF d;

	if (ergebnis==NULL)/* kein speicher reserviert fuer das ergebnis */
		{/*020488*/error("ergebnis == NULL in m_w_sc");return(ERROR);};

	d.ob_symchar = callocsymchar();  /* AK 161189 */
	B_KS_O(SYMCHAR, d, ergebnis);

	c_sc_w(ergebnis,wert); 
	c_sc_p(ergebnis,parlist); 
	c_sc_d(ergebnis,dim);
	return(OK);
#endif /* CHARTRUE */
	}

#ifdef CHARTRUE
OP s_sc_w(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	return(c.ob_symchar->sy_werte);
	}

OP s_sc_wi(a,i) OP a;INT i;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_v_i(s_sc_w(a),i));
	}

INT s_sc_wii(a,i) OP a;INT i;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_v_ii(s_sc_w(a),i));
	}

INT s_sc_wli(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_v_li(s_sc_w(a)));
	}

OP s_sc_p(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	return(c.ob_symchar->sy_parlist);
	}

OP s_sc_pi(a,i) OP a;INT i;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_v_i(s_sc_p(a),i));
	}

INT s_sc_pli(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_v_li(s_sc_p(a)));
	}

INT s_sc_di(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	return(s_i_i(s_sc_d(a)));
	}
OP s_sc_d(a) OP a;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	return(c.ob_symchar->sy_dimension);
	}

INT c_sc_d(a,b) OP a,b;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	c.ob_symchar->sy_dimension = b;
	return(OK);
	}

INT c_sc_p(a,b) OP a,b;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	c.ob_symchar->sy_parlist = b;
	return(OK);
	}

INT c_sc_w(a,b) OP a,b;
/* AK 140789 V1.0 */ /* AK 200891 V1.3 */
	{
	OBJECTSELF c;
	c = s_o_s(a);

	c.ob_symchar->sy_werte = b;
	return(OK);
	}

#endif /* CHARTRUE */

INT innermaxmofn(m,n,erg) OP m,n,erg;
	{
/* AK 091189 */
/* geschrieben fuer regev, diese routine berechnet fuer
eingebe 
INTEGER m
INTEGER n die zerlegung der summe der inneren tensorquadrate der
partitionen von n die hoechstens m teile haben 
ergebnis ist vom typ SCHUR 
*/
/* AK 200891 V1.3 */
#ifdef CHARTRUE
	OP a = callocobject();
	OP b = callocobject();
	OP c = callocobject();
	OP d = callocobject();
	first_partition(n,a);
	do {
	   if (le(s_pa_l(a),m)) {
		m_part_sc(a,b);mult(b,b,c);
		add(c,d,d);
		}
	   } while(next(a,a));
	reduce_symchar(d,erg);
	SYMfreeall(a); SYMfreeall(b); SYMfreeall(c); SYMfreeall(d);
	return(OK);
#endif /* CHARTRUE */
	}


#ifdef CHARTRUE
#ifdef KOSTKATRUE
INT young_tafel(a,res,ct,kt) OP a, res, ct, kt;
/* AK Mon Jan 23 09:59:22 MEZ 1989 */
/* a ist dimension res wird MATRIX
ct ist wenn ungleich NULL die charatertafel
kt ist wenn ungleich NULL die kostkatafel */
/* AK 200789 V1.0 */ /* AK 020290 V1.1 */ /* AK 200891 V1.3 */
	{
	OP zw	/* zwischenergebnis */,
		hct,hkt;
	INT i,j,k,l,dim;
	INT erg = OK;
	C1R(a,"young_tafel",res);


	if (check_equal_2(a,res,young_tafel,&erg) == EQUAL)
                goto endr_ende;

	dim = numberofpart_i(a);
	erg += m_ilih_nm(dim,dim,res);

	if (ct == NULL) 
		{ 
		hct = callocobject(); 
		erg += chartafel(a,hct);	
		}
	else    hct = ct;
	if (kt == NULL) 
		{ 
		hkt = callocobject(); 
		erg += kostka_tafel(a,hkt);	
		}
	else    hkt = kt;

	/* hct und hkt zeigen nun auf charactertafel und kostkatafel */
	/* um den youngcharacter zu berechnen sind nur mehr multiplikation
	von zeilen und spalten noetig */

	zw = callocobject(); 
	for (i=(INT)0; i<S_M_HI(res); i++)
	   for (j=(INT)0; j<S_M_HI(res); j++)
		{
		for (k=(INT)0; k<S_M_HI(res); k++)
			{ 
			erg += mult(S_M_IJ(hkt,i,k),S_M_IJ(hct,k,j),zw);
			erg += add_apply(zw,S_M_IJ(res,i,j)); 
			}
		};

	if (kt == NULL) 
		erg += SYMfreeall(hkt);
	if (ct == NULL) 
		erg += SYMfreeall(hct);
	/* die berechneten tafeln werden wieder geloescht */

	erg += SYMfreeall(zw);

	S1R(a,"young_tafel",res);
	ENDR("young_tafel");
	}
#endif /* KOSTKATRUE */
#endif /* CHARTRUE */


#ifdef CHARTRUE 
INT m_part_youngsc(a,b) OP a,b;
/* AK 020591 V1.2 */ /* AK 200891 V1.3 */
	{
	return young_character(a,b,NULL);
	}

INT young_character(a,res,yt) OP a,res,yt;
/* AK Mon Jan 23 13:04:51 MEZ 1989	*/
/* a ist PARTITION res wird SYMCHAR 
yt ist NULL oder sonst young_tafel */
/* AK 200789 V1.0 */ /* AK 100190 V1.1 */ /* AK 020591 V1.2 */
/* AK 200891 V1.3 */
	{
	OP hyt;
	OP d = callocobject(); 
	INT i,j,erg=OK;

	erg += weight(a,d);
	if  (yt == NULL) 
		{ 
		hyt = callocobject(); 
		erg += young_tafel(d,hyt,NULL,NULL); 
		}
	else	
		hyt = yt;

	/* hyt zeigt nun auf youngtafel, nun nurmehr zeile rauslesen */
	erg += b_d_sc(d,res);
	i = indexofpart(a);

	for (j=(INT)0; j<S_SC_PLI(res); j++)
		erg += copy(S_M_IJ(hyt,i,j),S_SC_WI(res,j));

	if (yt == NULL) 
		erg += SYMfreeall(hyt);
	
	ENDR("young_character");
	}

#endif /* CHARTRUE */

#ifdef CHARTRUE
#ifdef MATRIXTRUE
INT young_scalar_tafel(n,res,yt) OP n,res,yt;
/* AK Tue Jan 24 07:24:26 MEZ 1989 */
/* tafel der skalar produkte der young_charactere
n ist INTEGER dimension
res wird MATRIX des ergebnis
yt ist wenn != NULL die young_tafel */
/* AK 200789 V1.0 */ /* AK 260790  V1.1 */ /* AK 200891 V1.3 */
	{
	OP hyt, vecpart = callocobject(); 
	OP convec = callocobject();  /* vector mit der konjugiertenklassen
						ordnung */
	INT i,j,k,l,dim;
	makevectorofpart(n,vecpart);
	dim = S_V_LI(vecpart);
	m_il_v(dim,convec);
	for (k=(INT)0;k<dim;k++) 
		ordcon(S_V_I(vecpart,k), S_V_I(convec,k));
	m_ilih_m(dim,dim,res);
	if (yt == NULL) 
		{ 
		hyt = callocobject(); 
		young_tafel(n,hyt,NULL,NULL);
		}
	else    
		hyt = yt;
	/* hyt zeigt auf youngtafel */
	for ( i=(INT)0;i<S_M_HI(res);i++)
	  for ( j=(INT)0;j<S_M_HI(res);j++)
		char_matrix_scalar_product(hyt,i,hyt,j,vecpart,S_M_IJ(res,i,j),
		convec);
	if (yt == NULL) 
		SYMfreeall(hyt);
	SYMfreeall(vecpart); 
	SYMfreeall(convec); 
	return(OK);
	}
#endif /* MATRIXTRUE */
#endif /* CHARTRUE */

#ifdef CHARTRUE
#ifdef MATRIXTRUE
INT young_alt_scalar_tafel(n,res,yt) OP n,res,yt;
/* AK Tue Jan 24 09:05:18 MEZ 1989 */
/* tafel der skalar produkte des young_characters
mit dem young_character * alternierenden character
n ist INTEGER dimension
res wird MATRIX des ergebnis
yt ist wenn != NULL die young_tafel */
/* AK 200789 V1.0 */ /* AK 260790  V1.1 */ /* AK 200891 V1.3 */
	{
	OP hyt;
	OP vecpart = callocobject(); 
	OP hat = callocobject();  /* wird tafel des alternierenden mal 
		youngcharacter */
	OP altchar = callocobject(); /* alternierender character */
	OP lastpart = callocobject(); /* index des alt. character */
	INT i,j,k,l,dim;
	OP convec = callocobject();  
				

	makevectorofpart(n,vecpart);
	dim = S_V_LI(vecpart);
	m_il_v(dim,convec);
	for (k=(INT)0;k<dim;k++) ordcon(S_V_I(vecpart,k), S_V_I(convec,k));
	m_ilih_m(dim,dim,res);
	if (yt == NULL) { hyt = callocobject(); young_tafel(n,hyt,NULL,NULL);}
	else    hyt = yt;
	/* hyt zeigt auf youngtafel */
	last_partition(n,lastpart);
	m_part_sc(lastpart,altchar);
	copy(hyt,hat);
	for ( i=(INT)0;i<S_M_HI(res);i++)
	  for ( j=(INT)0;j<S_M_HI(res);j++)
		mult(S_SC_WI(altchar,j),S_M_IJ(hat,i,j),S_M_IJ(hat,i,j));
	SYMfreeall(altchar);SYMfreeall(lastpart);
	for ( i=(INT)0;i<S_M_HI(res);i++)
	  for ( j=(INT)0;j<S_M_HI(res);j++)
		char_matrix_scalar_product
					(hyt,i,hat,j,vecpart,
					S_M_IJ(res,i,j),
					convec);
	if (yt == NULL) SYMfreeall(hyt);
	SYMfreeall(vecpart); SYMfreeall(hat); SYMfreeall(convec); return(OK);
	}
#endif /* MATRIXTRUE */
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT test_symchar() 
/* AK 200891 V1.3 */
	{
	OP a = callocobject();
	OP b = callocobject();
	OP c = callocobject();
	FILE *fp1, *fp2;

	printf("test_symchar:scan(a)"); scan(SYMCHAR,a);println(a);
	printf("test_symchar:add(a,a,b)"); add(a,a,b); println(b);
	printf("test_symchar:add_apply(a,b)"); add_apply(a,b); println(b);
	printf("test_symchar:mult(a,b,b)"); mult(a,b,b); println(b);
	printf("test_symchar:mult_apply(a,b)"); mult_apply(a,b); println(b);
	printf("test_symchar:reduce_symchar(b,c)");
		reduce_symchar(b,c); println(c);
	printf("test_symchar:M_I_I(-1L,c);mult(c,b,b)");
	M_I_I(-1L,c); mult(c,b,b); println(b);
	printf("test_symchar:objectwrite(,b)");
	fp1 = fopen("klo","w"); objectwrite(fp1,b); fclose(fp1);
	printf("test_symchar:objectread(,b)");
	fp2 = fopen("klo","r"); objectread(fp2,b); fclose(fp2); println(b);
	printf("test_symchar:tex(b)"); tex(b);
	printf("test_symchar:hoch(a,cons_zwei,b)"); 
	hoch(a,cons_zwei,b); println(b);
	printf("test_symchar:scalarproduct(a,b,b)"); scalarproduct(a,b,b); 
	println(b);
	printf("test_symchar:charvalue(a,b,c);scan(PARTITION,a)");
	scan(PARTITION,a);
	printf("test_symchar:charvalue(a,b,c);scan(PERMUTATION,b)");
	scan(PERMUTATION,b);
	printf("test_symchar:charvalue(a,b,c)");charvalue(a,b,c,NULL);
	println(c);
	printf("test_symchar:M_I_I(7L,c);chartafel(c,b)");
	M_I_I(7L,c); chartafel(c,b); println(b);
	printf("test_symchar:M_I_I(7L,c);young_tafel(c,b)");
	M_I_I(7L,c); young_tafel(c,b,NULL,NULL); println(b);
	printf("test_symchar:M_I_I(7L,c);an_tafel(c,b)");
	M_I_I(7L,c); an_tafel(c,b); println(b);

	SYMfreeall(a);SYMfreeall(b);SYMfreeall(c);
	return(OK);
	}
	
#endif /* CHARTRUE */
/* now follows spechts method to compute an irreducible character */

#ifdef CHARTRUE
INT specht_m_part_sc(a,b) OP a,b;
/* AK 200891 V1.3 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += specht_irred_characteristik(a,c);
	erg += characteristik_to_symchar(c,b);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* CHARTRUE */
#ifdef MATRIXTRUE
#ifdef CHARTRUE
INT specht_irred_characteristik(a,b) OP a,b;
/* input PARTITION a
   output POLYNOM b */
/* AK 200891 V1.3 */
{
	INT i,j;
	OP c,d;
	if (S_O_K(a) != PARTITION) 
		return error("specht_ireed_characteristik: not PART");
	c = callocobject();
	if (S_PA_K(a) != VECTOR) 
		{
		t_EXPONENT_VECTOR(a,c);
		i = specht_irred_characteristik(c,b);
		SYMfreeall(c);
		return i;
		}
	d = callocobject();
	m_ilih_m(S_PA_LI(a),S_PA_LI(a),c);
	for (i=(INT)0;i<S_PA_LI(a);i++)
		for (j=(INT)0;j<S_PA_LI(a);j++)
			{
			m_i_i(S_PA_II(a,S_PA_LI(a)-1L-i)+j-i,d);
			specht_powersum(d,S_M_IJ(c,i,j));
			}
	det_imm_matrix(c,b);
	SYMfreeall(c); SYMfreeall(d);
	return OK;
}
#endif /* MATRIXTRUE */
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT specht_powersum(a,b) OP a,b;
/* input INTEGERobject a
   output POLYNOMobject */
/* AK 200891 V1.3 */
{
	static OP speicher = NULL; /* for the computed results */
	OP c,d,e,f,g;
	INT j;
	if (S_O_K(a) != INTEGER) return error("specht_powersum:a != INTEGER");
	if (nullp(a)) return m_scalar_polynom(cons_eins,b);
	if (negp(a)) return m_scalar_polynom(cons_null,b);
	if (S_I_I(a) >= (INT)100) return error("specht_powersum:a too big");

	if (speicher == NULL) { 
			speicher = callocobject();m_il_v((INT)100,speicher); }
	if (not EMPTYP(S_V_I(speicher, S_I_I(a)))) 
		return copy(S_V_I(speicher, S_I_I(a)),b);

	/* not yet computed */
	c = callocobject(); d = callocobject(); g=callocobject();
	e = callocobject(); f = callocobject();
	if (not EMPTYP(b)) freeself(b);
	first_part_EXPONENT(a,c);
	do {
		b_skn_po(callocobject(),callocobject(),NULL,d);
		m_il_v(S_PA_LI(c),S_PO_S(d));
		for (j=(INT)0;j<S_PA_LI(c);j++)
			m_i_i(S_PA_II(c,j), S_PO_SI(d,j) );
		/* now the exponents of the monom are ok */
		m_i_i((INT)1,g);
		for (j=(INT)0;j<S_PA_LI(c);j++)
			{
			fakul(S_PA_I(c,j), e);
			/* div3(S_PO_K(d),e,S_PO_K(d)); */
			m_i_i(j+(INT)1,f);
			hoch(f,S_PA_I(c,j),f); mult_apply(e,f);
			mult_apply(f,g);
			/* div3(S_PO_K(d),f,S_PO_K(d)); */
			}
		invers(g,S_PO_K(d));
		add_apply(d,b);
	} while(next(c,c));

	SYMfreeall(c); SYMfreeall(d); SYMfreeall(e); SYMfreeall(f); SYMfreeall(g);
	copy(b, S_V_I(speicher, S_I_I(a)));
	return OK;
}
#endif /* CHARTRUE */
#ifdef CHARTRUE
INT characteristik_to_symchar(a,b) OP a,b;
/* input: characteristik a
   output: coressponding sym character b */
/* AK 200891 V1.3 */
{
	INT i,j,oben,unten,mitte;
	OP z = a;
	OP c,d,e,f,g,h;
	if (z == NULL) return error("characteristik_to_symchar: z ==  NULL");
	c = callocobject(); d = callocobject();
	e = callocobject(); f = callocobject();
	 h = callocobject();

	m_ks_pa(EXPONENT,S_PO_S(z),d);
	weight (d,c); /* c is the degree of the symm group */
	m_d_sc(c,b);  /* b is a SYMCHAR object */
	m_il_v(S_SC_WLI(b),h);
	for (i=(INT)0;i<S_SC_PLI(b);i++)
		t_VECTOR_EXPONENT(S_SC_PI(b,i),S_V_I(h,i));
	while (z != NULL)
		{
		m_ks_pa(EXPONENT,S_PO_S(z),c);
		t_EXPONENT_VECTOR(c,d);
		unten=(INT)0;oben=S_V_LI(h)-(INT)1;
aaa:
		mitte = unten + (oben-unten) /2L;
		if ((i=comp_colex_part(d,S_SC_PI(b,mitte))) == (INT)0)  
			{i = mitte;goto aab;}
		else if (i>(INT)0)  unten=mitte+(INT)1; 
		else oben=mitte-(INT)1;
		if ( oben < unten ) {
			fprintln(stderr,d);
			fprintln(stderr,h);
			error("characteristik_to_symchar:part not found");
			}
		goto aaa;
aab:    /* part gefunden */
		/* i = indexofpart(c); */
		copy(S_PO_K(z), S_SC_WI(b,i));
		for (j=(INT)0;j<S_PA_LI(c);j++)
			{
			fakul(S_PA_I(c,j), e);
			mult_apply(e,S_SC_WI(b,i));
			m_i_i(j+(INT)1,f);
			hoch(f,S_PA_I(c,j),f);
			mult_apply(f,S_SC_WI(b,i));
			}
		z = S_PO_N(z);
		}
	SYMfreeall(c); SYMfreeall(f); SYMfreeall(e); SYMfreeall(h); SYMfreeall(d); 
	return OK;
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT characteristik_symchar(a,b) OP a,b;
/* AK 020191 */
/* enter symchar a 
   out:  polynom b */
/* AK 200891 V1.3 */
{
	INT i,j;
	OP c = callocobject();
	OP d = callocobject();
	OP e = callocobject();
	OP f = callocobject();

	if (not EMPTYP(b)) freeself(b);

	for (i = (INT)0; i< S_SC_PLI(a); i++)
		{
		t_VECTOR_EXPONENT(S_SC_PI(a,i),c);
		b_skn_po(callocobject(),callocobject(),NULL,d);
		m_il_v(S_SC_DI(a),S_PO_S(d));
		for (j=(INT)0;j<S_SC_DI(a);j++)
			if (j >= S_PA_LI(c) ) m_i_i((INT)0,S_PO_SI(d,j));
			else m_i_i(S_PA_II(c,j), S_PO_SI(d,j) );
		/* now the exponents of the monom are ok */
		copy(S_SC_WI(a,i) , S_PO_K(d) );
		for (j=(INT)0;j<S_PA_LI(c);j++)
			{
			fakul(S_PA_I(c,j), e);
			div3(S_PO_K(d),e,S_PO_K(d));
			m_i_i(j+(INT)1,f);
			hoch(f,S_PA_I(c,j),f);
			div3(S_PO_K(d),f,S_PO_K(d));
			}
		add(d,b,b);
		}

	SYMfreeall(c); SYMfreeall(d); SYMfreeall(e); SYMfreeall(f);
	return OK;
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT c_ijk_sn(a,b,c,g) OP a,b,c,g;
/* structur constanten classen multiplikation in s_n
Curtis Reiner Methods of representation theory I p.216
AK 020891 V1.3 */
{
	OP d,e,f,h,h2;
	INT i,erg=OK;

	d=callocobject(); 
	e=callocobject(); 
	f=callocobject(); 
	h=callocobject(); 
	h2=callocobject(); 

	erg += weight(a,d);
	erg += makevectorofpart(d,e);
	erg += ordcon(a,f); 
	erg += ordcon(b,g);
	erg += mult_apply(f,g); 
	erg += m_i_i((INT)0,h);
	for (i=(INT)0;i<S_V_LI(e);i++)
		{
		erg += charvalue(S_V_I(e,i),a,f,NULL);
		erg += charvalue(S_V_I(e,i),b,h2,NULL);
		erg += mult_apply(f,h2);
		erg += charvalue(S_V_I(e,i),c,f,NULL);
		erg += mult_apply(f,h2);
		erg += dimension(S_V_I(e,i),f);
		erg += div3(h2,f,h2);
		erg += add_apply(h2,h);
		}
	erg += mult_apply(h,g);
	erg += fakul(d,f);
	erg += div3(g,f,g);

	erg += SYMfreeall(d); erg += SYMfreeall(e);
	erg += SYMfreeall(f);erg += SYMfreeall(h);erg += SYMfreeall(h2);
	return erg;
}
#endif /* CHARTRUE */

#ifdef CHARTRUE
#ifdef SCHURTRUE
INT t_SCHUR_SYMCHAR(a,b) OP a,b;
/* input SCHUR output character */
{
	OP z = a;
	OP c;
	INT erg = OK;

	if (S_O_K(a) != SCHUR) 
		{
		cast_apply_schur(a); /* AK 280494 */
		if (S_O_K(a) != SCHUR) 
			return WTO("t_SCHUR_SYMCHAR",a);
		}

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


	c = callocobject();

	erg += m_i_i((INT)0,b);
	while(z != NULL)
		{
		erg += m_part_sc(S_S_S(z),c);
		erg += mult_apply(S_S_K(z),c);
		erg += add_apply(c,b);
		z = S_S_N(z);
		}
	erg += SYMfreeall(c);

	if (erg != OK)
		EDC("t_SCHUR_SYMCHAR");

	return erg;
}
#endif /* SCHURTRUE */
#endif /* CHARTRUE */

#ifdef CHARTRUE
INT vminus_tabloid(a,b) OP a,b;
/* eingabe tableau, ausgabe tabloid */
/* AK 270295 */
{
	OP e,f,g,x,z,h,d;
	INT erg = OK;
        if (check_equal_2(a,b,vminus_tabloid,&erg) == EQUAL)
                goto eee;
 
        x = callocobject();
        f = callocobject();
        g = callocobject();
        erg += vminus(a,f);
        z =f;
        erg += init(SYMLIST,b);
        while (z!=NULL) {
                erg += operate_perm_tableaux(S_PO_S(z),a,x);
                h=callocobject();
                erg += sort_rows_tableaux_apply(x);
                erg += m_sk_mo(x,S_PO_K(z),h);
                insert(h,b,add_koeff,NULL);
                z = S_PO_N(z);
		}
	erg += SYMfreeall(x);
	erg += SYMfreeall(f);
	erg += SYMfreeall(g);
eee:
	ENDR("vminus_tabloid");
}

#endif /* CHARTRUE */

#ifdef CHARTRUE
#endif /* CHARTRUE */
