#include "def.h"
#include "macro.h"

#define callocobject callocobject_trace
#undef callocobject
#ifdef SCHURTRUE
#define SR_LENGTH 100
#define SR_DEPTH 100

static INT co_sy_sy_co();
static char (* ps)[SR_LENGTH] = NULL;/* permutationen */
static short (* ms)[3]   = NULL; 	/* maximal place  at 0 */
/* end of first increasing part at 1 */
/* length of the perm at 2 */
static short stacklevel; 		/* the actuell level */
static short permlength;		/* the length of the permutation */

typedef  char axk[SR_LENGTH] ;
typedef  short axl[3] ;
static INT add_schur_schur_co();
static INT scan_schur_co();
static INT newtrans_main();
static INT newtrans_main_limit();
static INT newtrans_main_limitfunction();
static INT newtrans_main_limit_limitfunction();
static INT newtrans_printstack();
static INT newtrans_nextstep();
static INT newtrans_start();

// GCC 3.4 complains if we do not predeclare the following function:
static INT mult_power_part(OP a, OP b, OP c);


INT schur_ende() /* AK 100692 */
{
	if (ps != NULL) 
		SYM_free(ps);
	if (ms != NULL) 
		SYM_free(ms);
	return OK;
}

static INT newtrans_main(perm,e)OP perm,e;/* AK 020290 V1.1 AK 200891 V1.3 */
{
	short i,j;
	extern short stacklevel;
	extern char (* ps)[SR_LENGTH];
	extern short   (* ms)[3];

	if (ps == NULL) {
		ps = (axk * )  SYM_calloc(SR_DEPTH,sizeof(axk));
		if (ps == NULL) 
			return no_memory();
		}
	if (ms == NULL) {
		ms = (axl *) SYM_calloc(SR_DEPTH,sizeof(axl));
		if (ms == NULL) 
			return no_memory();
		}

	newtrans_start(perm);
mainaa:
	if (ms[stacklevel][1] == ms[stacklevel][0])
	/* this means it is grassmanian */
	{
		OP ent=callocobject(); /* eintrag */
		INT insert_erg;
		init(MONOM,ent);
		init(PARTITION,S_MO_S(ent));
		m_il_v((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
		M_I_I((INT)1,S_MO_K(ent));
		for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
		    if (  (ps[stacklevel] [i]) - i - 1 > 0 ) {
			M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
			    S_PA_I(S_MO_S(ent),j)); j++; }
		if (j>1)
			M_I_I((INT)j, S_PA_L(S_MO_S(ent))); /* j eingefuegt AK 170790 */
		else if (j==1) /* AK 121093 */
			{
			i = S_PA_II(S_MO_S(ent),(INT)0);
			m_il_v((INT)1,S_PA_S(S_MO_S(ent)));
			M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
			} 
		insert_erg=insert(ent,e,add_koeff,comp_monomvector_monomvector);
		stacklevel--;
	}
	else newtrans_nextstep();
	/* compute next level from last entry in stack */
	if (stacklevel != -1) goto mainaa;
	return(OK);
}


static INT newtrans_nextstep() /* AK 200891 V1.3 */
{
	extern short stacklevel;
	extern char (* ps )[SR_LENGTH];
	extern short (* ms)[3];

	short i,j;
	short maxplace =  ms [stacklevel][0];
	/* the position before the last decrease */
	char maxentry = ps  [stacklevel][ms [stacklevel][0]];
	/* this is the entry at the maximal place */
	char rightlessvalue;
	/* this is the value on this place */
	short minimalleftvalue;
	/* the minimal value to the left which is allowed
	to be exchanged with entry on the maxplace */
	short startloop;

	/* first we look whether we could reduce the length of the perm */

	for (i=ms[stacklevel][2] -1; i>0; i--)
		if (ps[stacklevel][i] == (char)i+1) ms[stacklevel][2]--;
		else break;
	/* now we have reduced the length of the alphabet */

	/* now we compute these rightvalues */
	for (i=ms[stacklevel][2] - 1; i> 0 ; i--)
		if ( ps [stacklevel][i] < maxentry) break;
	/* i is now the required place */
	rightlessvalue =  ps [stacklevel][i];
	/* now we have to exchange */
	ps  [stacklevel][i] =  maxentry;
	ps  [stacklevel][maxplace] =  rightlessvalue;

	/* you must look whether rightlessvalue == 1
because this means you have to enlarge the permutation */

	startloop = maxplace-1;
	if (rightlessvalue == 1)
	{
		ms[stacklevel][2]++;
		for (i=ms[stacklevel][2]-1; i>0 ; i--)
			ps[stacklevel][i]=ps[stacklevel][i-1]+1;
		ps[stacklevel][0]=(char)1;
		ms[stacklevel][0]++;
		ms[stacklevel][1]++;
		rightlessvalue=2;
		maxplace++;
		startloop=0;
	}

	/* now we have to compute all possible changes to the left */
	minimalleftvalue = 0;
	for (i=startloop; i>=0; i--)
	{
		if (( ps  [stacklevel][i] < rightlessvalue)
		    && ((short) ps  [stacklevel][i] > minimalleftvalue))
		{
			/* now these things have to be copied and to be exchanged */
			if (stacklevel+1 == SR_DEPTH)
			/* this means the stack is to small */
				error("newtrans:stackoverflow");/* AK 121192 */
			/* you generate a copy of the upper stack-entry */

			if (i>0)
			{
				memcpy(	&(ps[stacklevel+1][0]),
				    &(ps[stacklevel][0]),
				    (int)(ms[stacklevel][2]));
				memcpy(	&(ms[stacklevel+1][0]),
				    &(ms[stacklevel][0]),6);
			}
			/* you got a copy */

			ps [stacklevel][maxplace]=ps[stacklevel][i];
			ps [stacklevel][i]=rightlessvalue;
			minimalleftvalue = (short)ps[stacklevel][maxplace];
			/* we have now to compute the new values for
		minstack and ms */
			for (j=ms[stacklevel][1]+1;j<ms[stacklevel][2];j++)
				if (ps[stacklevel][j] < ps[stacklevel][j-1])
					break;
			ms[stacklevel][1] = j-1;
			/* this is the new value of the minstackentry */

			for (j=ms[stacklevel][0];j>=0;j--)
				if (ps[stacklevel][j] > ps[stacklevel][j+1])
					break;
			ms[stacklevel][0] = j;
			/* this is the new value of the msentry */
			if (minimalleftvalue == (rightlessvalue - 1)) return(0);
			else stacklevel++;
		}
		if ((i==0)&&(minimalleftvalue==0))
		/* you have to enlarge the permutation */
		{
			ms[stacklevel][2]++;
			for (i=ms[stacklevel][2]-1; i>0 ; i--)
				ps[stacklevel][i]=ps[stacklevel][i-1]+1;
			ps[stacklevel][0]=(char)1;
			ms[stacklevel][1]++;
			ms[stacklevel][0]++;
			rightlessvalue++;
			maxplace++;
			ps [stacklevel][maxplace]=ps[stacklevel][i];
			ps [stacklevel][i]=rightlessvalue;
			minimalleftvalue = (short)ps[stacklevel][maxplace];
			/* we have now to compute the new values for
		minstack and ms */
			for (j=ms[stacklevel][1]+1;j<ms[stacklevel][2];j++)
				if (ps[stacklevel][j] < ps[stacklevel][j-1])
					break;
			ms[stacklevel][1] = j-1;
			/* this is the new value of the minstackentry */

			for (j=ms[stacklevel][0];j>=0;j--)
				if (ps[stacklevel][j] > ps[stacklevel][j+1])
					break;
			ms[stacklevel][0] = j;
			/* this is the new value of the msentry */
			return(0);
		}
	}
	stacklevel--;
	return OK;
}

#ifdef UNDEF
static INT newtrans_printstack()
/* AK 200891 V1.3 */
{
	/* the routine prints the stack */
	short i,j;
	extern short stacklevel;
	extern char (* ps) [SR_LENGTH];
	extern short (* ms)[3];

	for (i=0;i<=stacklevel;i++)
	{
		for (j=0;j<ms[i][2];j++)
			printf(" %d ",(short)ps[i][j]);
		printf(":%d %d %d\n",ms[i][0],ms[i][1],ms[i][2]);
	};
	return(OK);
}
#endif /* UNDEF */



static INT newtrans_start(perm) OP perm; /* AK 221289 V1.1 AK 200891 V1.3 */
{
	short i;
	INT erg = OK;
	extern short permlength;
	extern short stacklevel;
	extern char (* ps) [SR_LENGTH];
	extern short (* ms)[3];

	permlength = S_P_LI(perm);
	if (permlength > SR_LENGTH)
	/* the error condition the perm do not fit into the stack */
	{
		fprintln(stderr,perm);
		fprintf(stderr,
	"please enter a permutation of a length <= %d\n",SR_LENGTH);
		erg += error("newtrans_start:internal error");
		goto endr_ende;
	}
	stacklevel = (short)0;
	ms[0][2]=permlength;

	for (i=0; i<permlength ; i++)
	{
		ps  [stacklevel][i] = (char)S_P_II(perm,i);
	}
	/* now we are looking for the first and the last decrease */
	for (i=1; i<permlength ; i++)
		if (ps [stacklevel][i] < ps [stacklevel][i-1]) break;
	/* now i is the index of the first decrease */
	ms [stacklevel][1] = i-1;


	for (i=permlength-2 ;i>=0; i--)
		if (ps [stacklevel][i] > ps [stacklevel][i+1]) break;
	/* now i+1 is the index of the last decrease */
	ms [stacklevel][0] = i;
	ENDR("newtrans_start:internal function");
}

INT newtrans(perm,c) OP perm,c;
/* AK 221289 V1.1 */ /* AK 130891 V1.3 */
	{ 
	INT erg = OK;
	CTO(PERMUTATION,"newtrans",perm);
	if (einsp_permutation(perm)) 
		{
		erg += m_scalar_schur(cons_eins,c);
		}
	else
		{
		erg += init(BINTREE,c);
		erg += newtrans_main(perm,c); 
		erg += t_BINTREE_SCHUR(c,c);
		}
	ENDR("newtrans");
	}

INT newtrans_limit_limitfunction(perm,c,d,f,limit) OP perm,c,d,limit; INT (*f)();
/* AK 221289 V1.1 */ /* AK 200891 V1.3 */
{ 
	INT erg = OK;
	erg += init(BINTREE,c);
	erg += newtrans_main_limit_limitfunction(perm,c,d,f,limit); 
	erg += t_BINTREE_SCHUR(c,c);
	ENDR("newtrans_limit_limitfunction");
}


INT newtrans_limitfunction(perm,c,f,limit) OP perm,c,limit; INT (*f)();
/* AK 221289 V1.1 */ /* AK 200891 V1.3 */
{ 
	INT erg = OK;
	erg += init(BINTREE,c);
	erg += newtrans_main_limitfunction(perm,c,f,limit); 
	erg += t_BINTREE_SCHUR(c,c);
	ENDR("newtrans_limitfunction");
}


static INT newtrans_main_limit_limitfunction(perm,c,d,f,limit) OP d,perm,c,limit;
	INT (*f)();
/* d is a limit on the length of the partitions */
/* AK 221289 V1.1 */ /* AK 200891 V1.3 */
{
	short i,j;
	extern short stacklevel;
	extern char (* ps) [SR_LENGTH];
	extern short (* ms)[3];

	if (ps == NULL) {
		ps= (axk * ) SYM_calloc( SR_DEPTH,sizeof(axk));
		if (ps== NULL) 
			return no_memory();
		}
	if (ms == NULL) {
		ms = (axl *) SYM_calloc( SR_DEPTH,sizeof(axl));
		if (ms == NULL) 
			return no_memory();
		}
	newtrans_start(perm);
mainaa:
	if (ms[stacklevel][1] == ms[stacklevel][0])
	/* this means it is grassmanian */
	{
		OP ent; /* eintrag */
		INT insert_erg;
		if ((INT)ms[stacklevel][1] + 1 <= S_I_I(d))
                {
                        /* partition ist kurz genug */
		ent = callocobject();
		init(MONOM,ent);
                init(PARTITION,S_MO_S(ent));
                m_il_v((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
                M_I_I((INT)1,S_MO_K(ent));
                for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
                    if (  (ps[stacklevel] [i]) - i - 1 > 0 ) {
                        M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
                            S_PA_I(S_MO_S(ent),j)); j++; }
                if (j>1)
			M_I_I((INT)j, S_PA_L(S_MO_S(ent)));
                else if (j==1) /* AK 121093 */
                        {
                        i = S_PA_II(S_MO_S(ent),(INT)0);
                        m_il_v((INT)1,S_PA_S(S_MO_S(ent)));
                        M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
                        }

		if ((*f)(S_MO_S(ent),limit) == TRUE)
		{
			insert_erg=insert(ent,c, add_koeff,NULL);
		}
		else SYMfreeall(ent);
	 	}
		stacklevel--;
	}
	else newtrans_nextstep();
	/* compute next level from last entry in stack */
	if (stacklevel != -1) goto mainaa;
	return(OK);
}


static INT newtrans_main_limitfunction(perm,c,f,limit) OP perm,c,limit;
	INT (*f)();
/* limit is a limit on the length of the partitions */
/* AK 221289 V1.1 */ /* AK 200891 V1.3 */
{
	short i,j;
	extern short stacklevel;
	extern char (* ps) [SR_LENGTH];
	extern short (* ms)[3];

	if (ps == NULL) {
		ps= (axk * ) SYM_calloc( SR_DEPTH,sizeof(axk));
		if (ps== NULL) 
			return no_memory();
		}
	if (ms == NULL) {
		ms = (axl *) SYM_calloc( SR_DEPTH,sizeof(axl));
		if (ms == NULL) 
			return no_memory();
		}
	newtrans_start(perm);
mainaa:
	if (ms[stacklevel][1] == ms[stacklevel][0])
	/* this means it is grassmanian */
	{
		OP ent; /* eintrag */
		INT insert_erg;
		ent = callocobject();
		init(MONOM,ent);
                init(PARTITION,S_MO_S(ent));
                m_il_v((INT) ms[stacklevel][1] + 1, S_PA_S(S_MO_S(ent)));
                M_I_I((INT)1,S_MO_K(ent));
                for (i=(short)0,j=(short)0; i<= ms[stacklevel][1]; i++)
                    if (  (ps[stacklevel] [i]) - i - 1 > 0 ) {
                        M_I_I((INT) (ps[stacklevel] [i]) - i - (INT)1,
                            S_PA_I(S_MO_S(ent),j)); j++; }
                if (j>1)
			M_I_I((INT)j, S_PA_L(S_MO_S(ent)));
                else if (j==1) /* AK 121093 */
                        {
                        i = S_PA_II(S_MO_S(ent),(INT)0);
                        m_il_v((INT)1,S_PA_S(S_MO_S(ent)));
                        M_I_I(i,S_PA_I(S_MO_S(ent),(INT)0));
                        }

		if ((*f)(S_MO_S(ent),limit) == TRUE)
		{
			insert_erg=insert(ent,c, add_koeff,NULL);
		}
		else SYMfreeall(ent);
		
		stacklevel--;
	}
	else newtrans_nextstep();
	/* compute next level from last entry in stack */
	if (stacklevel != -1) goto mainaa;
	return(OK);
}

#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT schnitt_schur(a,b,c) OP a,b,c;
/* gemeinsame bestandteile der schurfunktionen a und b nach c*/
/* AK 310789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
{
	OP zeigera, zeigerb;
	INT erg=OK,e;

	if (not EMPTYP(c)) 
		erg += freeself(c); 
	zeigera=a; zeigerb=b;
	while(zeigera != NULL && zeigerb !=NULL)
	{
		e =  comp(S_S_S(zeigera),S_S_S(zeigerb));
		if (e == (INT)0)
		{
			OP neu = callocobject();
			erg += m_pa_s(S_S_S(zeigera),neu); /* AK 201192 */
			if (ge(S_S_K(zeigerb),S_S_K(zeigera)))
				erg +=	copy(S_S_K(zeigera),S_S_K(neu));
			else 
				erg += copy(S_S_K(zeigerb),S_S_K(neu));

			insert(neu,c,add_koeff,comp);
			zeigera=S_S_N(zeigera);
			zeigerb=S_S_N(zeigerb);
		}
		else if (e < (INT)0) zeigera=S_S_N(zeigera);
		else if (e > (INT)0) zeigerb=S_S_N(zeigerb);
	};
	ENDR("schnitt_schur");
}



INT tex_schur(poly) OP poly;
/* AK 101187 */ /* zur ausgabe eines Schurpolynoms */
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */
/* AK 070291 V1.2 prints to texout */ /* AK 200891 V1.3 */
{
	OP zeiger = poly;

	fprintf(texout,"\\ ");
	if (EMPTYP(poly)) return(OK);
	while (zeiger != NULL)
	{
		if (not einsp (S_S_K(zeiger)))
			/* der koeffizient wird nur geschrieben wenn er
			ungleich 1 ist */
			if (listp(S_S_K(zeiger))) { /* AK 130397 */
				fprintf(texout,"(");
				tex(S_S_K(zeiger));
				fprintf(texout,")");
						}
			else	{
				tex(S_S_K(zeiger));
				}
		fprintf(texout,"\\ $S_{ ");
		fprint(texout,S_S_S(zeiger));
		fprintf(texout," } $\\ ");
		zeiger = S_S_N(zeiger);
		if (zeiger != NULL) fprintf(texout," $+$ ");
		texposition += 15;
		if (texposition >70) {
			fprintf(texout,"\n");
			texposition = 0;
		}
	};
	fprintf(texout,"\\ ");
	texposition += 3;
	return(OK);
}
#endif /* SCHURTRUE */



#ifdef  MATRIXTRUE 
#ifdef  SCHURTRUE 
INT compute_skewschur_with_alphabet_det(a,b,c) OP a,b,c;
/* skewschurpolyomial with det */
/* AK 090790 V1.1 */ /* AK 250291 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK,i,j,gli,kli;
	OP d,h;
	d = callocobject();
	h = callocobject();
	gli = S_SPA_GLI(a);
	kli = S_SPA_KLI(a); /* alt gli */
	erg += m_ilih_m(gli,gli,d);
	for (i=(INT)0; i<gli; i++)
		for (j=(INT)0; j<gli; j++)
			{
			if (i >= (gli - kli) )
				m_i_i(S_SPA_GII(a,j)+j-i-
				      S_SPA_KII(a,i-gli+kli)
				      ,h);
			else
				m_i_i(S_SPA_GII(a,j)+j-i,h);
			erg += compute_complete_with_alphabet(h,b,S_M_IJ(d,i,j));
			}
	erg += det_mat_imm(d,c);
	erg += SYMfreeall(d); 
	erg += SYMfreeall(h);  /* AK 160893 */
	ENDR("compute_skewschur_with_alphabet_det");
}
#endif /* SCHURTRUE */
#endif /* MATRIXTRUE */


#ifdef  MATRIXTRUE 
#ifdef  SCHURTRUE 
#ifdef  CHARTRUE 
INT compute_schur_with_alphabet_det(a,b,c) OP a,b,c;
/* schurpolyomial with det */ 
/* AK 090790 V1.1 */ /* AK 200891 V1.3 */
{
	INT i,j;
	INT erg = OK;
	OP d = callocobject();
	OP h = callocobject();
	erg += m_ilih_m(S_PA_LI(a),S_PA_LI(a),d);
	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,j)+j-i,h);
		erg += compute_complete_with_alphabet(h,b,S_M_IJ(d,i,j));
			}
	erg += det_mat_imm(d,c);
	erg += SYMfreeall(d); 
	erg += SYMfreeall(h);   /* fehlte AK 301092 */
	return erg;
}
#endif /* CHARTRUE */
#endif /* SCHURTRUE */
#endif /* MATRIXTRUE */


#ifdef SCHURTRUE
INT compute_schur(part,res) OP part,res;
/* AK 161187 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 260291 V1.2 */
/* AK 200891 V1.3 */
{
	OP l;
	INT erg = OK;
	l=callocobject();
	erg += weight( part,l);
	erg += compute_schur_with_alphabet(part,l,res);
	erg += SYMfreeall(l);
	ENDR("compute_schur");
}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT t_POLYNOM_MONOMIAL(a,b) OP a,b;
/* assumes a is symmetric */
/* AK 080591 V1.2 */ /* AK 200891 V1.3 */
	{
	OP c,d,e;
	INT erg = OK;
	if (not EMPTYP(b)) 
		erg += freeself(b);
	c = callocobject();
	erg += copy(a,c);
	e = callocobject();
	while (not nullp(c))
		{
		d = callocobject();
		erg += m_v_mon(S_PO_S(c),d);
		erg += copy(S_PO_K(c),S_S_K(d));
		erg += compute_monomial_with_alphabet(
				S_S_S(d),S_V_L(S_PO_S(c)),e);
		mult_apply(S_PO_K(c),e);
		erg += sub(c,e,c);
		insert(d,b,NULL,NULL);
		}	
	erg += SYMfreeall(e);
	erg += SYMfreeall(c);
	return erg;
	}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT t_POLYNOM_POWER(a,b) OP a,b;
/* assumes a is symmetric */
/* AK 080591 V1.2 */		/* AK 200891 V1.3 */
	{
	OP c,d,e,f;
	OP pa,z;
	INT pain,i;
	INT erg = OK;
	if (S_O_K(a) != POLYNOM)
		return ERROR;
	if (not EMPTYP(b)) 
		erg += freeself(b);
	c = callocobject();
	erg += copy(a,c);
	e = callocobject();
	while (not nullp(c))
		{
		d = callocobject();
		z = c; pa = c; 
		pain = (INT)0;
		while (z != NULL)
			{
			erg += m_v_pa(S_PO_S(z),d);
			if ((i=indexofpart(d)) > pain) 
				{
				pain = i;
				pa = z;
				}
			z = S_PO_N(z);
			}
		/* pain ist index der lex kleinsten partition
                   pa der zugehoerige POLYNOM zeiger */
		erg += m_v_ps(S_PO_S(pa),d);
		erg += copy(S_PO_K(pa),S_S_K(d));
		erg += compute_power_with_alphabet(
				S_S_S(d),S_V_L(S_PO_S(pa)),e);
		z = e;
		while (z != NULL)
			{
			if (EQ(S_PO_S(z),S_PO_S(pa)))
			/* find coeff of the leading monom */
				{
				f = callocobject();
				copy(S_PO_K(z),f);
				invers_apply(f);
				mult_apply(f,e);
				break;
				}
			z = S_PO_N(z);
			}
		erg += mult_apply(S_PO_K(pa),e);
		erg += sub(c,e,c);
		erg += mult_apply(f,d); /* AK 020394 */
		erg += SYMfreeall(f);
		insert(d,b,NULL,NULL);
		}	
	erg += SYMfreeall(e);
	erg += SYMfreeall(c);
	return erg;
	}

INT t_POLYNOM_SCHUR(a,b) OP a,b; 
/* assumes a is symmetric */
/* AK 020394 */
{
	OP c;
	INT erg = OK;
	c = callocobject();
	erg += t_POLYNOM_POWER(a,c);
	erg += t_POWSYM_SCHUR(c,b);
	erg += SYMfreeall(c);
	ENDR("t_POLYNOM_SCHUR");
}

INT t_POLYNOM_ELMSYM(a,b) OP a,b;
/* assumes a is symmetric */
/* AK 120995 faster version */
{
	OP c,d,e,f,g;
	INT erg = OK;
	erg += init(ELMSYM,b);
	if (nullp(a)) goto ee;

	d = callocobject();
	e = callocobject();
	f = callocobject();
	erg += numberofvariables(a,d);
	erg += copy(a,f);
	while (not nullp(f))
	{
	c = callocobject();
	g = callocobject();
	erg += m_v_pa(S_PO_S(f),c);
	erg += conjugate(c,c);
	erg += compute_elmsym_with_alphabet(c,d,e);
	erg += b_skn_e(c,callocobject(),NULL,g);
	erg += copy(S_PO_K(f),S_S_K(g));
	insert(g,b,NULL,NULL);
	erg += mult_scalar_polynom(S_PO_K(f),e,e);
	erg += sub(f,e,f);
	}

	erg += SYMfreeall(d);
	erg += SYMfreeall(e);
	erg += SYMfreeall(f);
ee:
	ENDR("t_POLYNOM_ELMSYM");
}


#endif /* SCHURTRUE */

static INT c_m_w_a_vp(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
	{
	OP e,f,g;
	INT erg = OK,i;
	e = callocobject();
	erg += first_permutation(b,e);
	f = callocobject();
	m_l_v(b,f);
	for (i=(INT)0;i<S_I_I(b);i++)
		if (i < S_PA_LI(a)) M_I_I(S_PA_II(a,i),S_V_I(f,i));
		else M_I_I((INT)0,S_V_I(f,i));
	/* f is vector */
	do 
		{
		g = callocobject();
		b_skn_po(callocobject(),callocobject(),NULL,g);
		M_I_I((INT)1,S_PO_K(g));
		operate_perm_vector(e,f,S_PO_S(g));
		insert(g,c,NULL,NULL);
		} while(next(e,e));

	/* nur koeff mit 1 */
	g = c;
	while (g != NULL)
		{
		if (not einsp(S_PO_K(g)))
			m_i_i((INT)1,S_PO_K(g));
		g = S_PO_N(g);
		}

	erg += SYMfreeall(f);
	erg += SYMfreeall(e);
	return erg;
	}

#ifdef PARTTRUE
INT compute_monomial_with_alphabet(number,l,res) OP number,res,l;
/* AK 090790 V1.1 */ /* AK 090591 V1.2 */ /* AK 200891 V1.3 */
	{
	INT erg = OK;
	OP c,z;

	
	if (check_equal_3(number,l,res,compute_monomial_with_alphabet,&erg) 
		== EQUAL)
		goto rr;

	CTO(INTEGER,"compute_monomial_with_alphabet",l);
	if (not EMPTYP(res)) 
		erg += freeself(res);
	if (S_O_K(number) == PARTITION)
		{
		if (S_PA_K(number) != VECTOR) 
			{
			OP c = callocobject();
			erg += t_VECTOR_EXPONENT(number,c);
			erg += compute_monomial_with_alphabet(c,l,res);
			erg += SYMfreeall(c);
			goto rr;
			}
		/* number is VECTOR partition */
		if (GR(S_PA_L(number),l))
			return OK;  /* sind 0 */
		erg += c_m_w_a_vp(number,l,res);
		goto rr;
		}
	else if (S_O_K(number) == INTEGER)
		{
		c = callocobject();
		erg += m_i_pa(number,c);
		erg += compute_monomial_with_alphabet(c,l,res);
		erg += SYMfreeall(c);
		goto rr;
		}
	else if (S_O_K(number) == MONOMIAL)
	{
	m_i_i((INT)0,res);
	if (S_L_S(number) == NULL)
		return OK;
	c = callocobject();
	z = number;
	while (z != NULL)
		{
		erg += compute_monomial_with_alphabet(S_S_S(z),l,c);
		erg += mult_apply(S_S_K(z),c);
		erg += add_apply(c,res);
		z = S_S_N(z);
		erg += freeself(c);
		}
	erg += SYMfreeall(c);
	goto rr;
	}
	else
	  return WTT("compute_monomial_with_alphabet",number,l);
	
rr:
	ENDR("compute_monomial_with_alphabet");
	}

#endif /* PARTTRUE */
#ifdef PARTTRUE

#ifdef SCHURTRUE
INT compute_complete_with_alphabet(number,l,res) OP number,res,l;
/* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 200891 V1.3 */
/* number may be INTEGER,PARTITION or HOM_SYM */
	{
	OP b,z;
	INT erg=OK,i;
	if (not EMPTYP(res)) 
		erg += freeself(res);

	if (S_O_K(number) == INTEGER) /* AK 080992 */
	{
	if (nullp(number)) 
		return M_I_I((INT)1,res); 
	if (negp(number)) 
		return M_I_I((INT)0,res); 

	b = callocobject();
	erg += m_i_pa(number,b);
	erg += compute_schur_with_alphabet(b,l,res);
	erg += SYMfreeall(b); 
	}
	else if (S_O_K(number) == PARTITION) /* AK 080992 */
	{
	if (S_PA_K(number) != VECTOR) 
		return ERROR;
	m_i_i((INT)1,res);
	b = callocobject();
	for (i=(INT)0;i<S_PA_LI(number);i++)
		{
		erg += compute_complete_with_alphabet(S_PA_I(number,i),l,b);
		erg += mult_apply(b,res);
		erg += freeself(b);
		}
	erg += SYMfreeall(b);
	}
	else if (S_O_K(number) == HOM_SYM)
	{
	m_i_i((INT)0,res);
	b = callocobject();
	z = number;
	while (z != NULL)
		{
		erg += compute_complete_with_alphabet(S_S_S(z),l,b);
		erg += mult_apply(S_S_K(z),b);
		erg += add_apply(b,res);
		z = S_S_N(z);
		erg += freeself(b);
		}
	erg += SYMfreeall(b);
	}
	else
		return ERROR;
	return erg;
	}
#endif /* SCHURTRUE */
	
#endif /* PARTTRUE */

#ifdef PARTTRUE
INT compute_elmsym_with_alphabet(label,l,result) OP l,label,result;
/* AK 120391 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	INT i;
	OP zw,z;
        if (check_equal_3(label,l,result,compute_elmsym_with_alphabet,&erg) 
		== EQUAL)
		goto rr;

        CTO(INTEGER,"compute_elmsym_with_alphabet",l);

	if (not EMPTYP(result)) 
		erg += freeself(result);
	if (S_O_K(label) == INTEGER)
		{
		erg += init(POLYNOM,result);
		zw = callocobject();
		erg += last_partition(label,zw);
		erg += compute_monomial_with_alphabet(zw,l,result);	
		erg += SYMfreeall(zw);
		}
	else if (S_O_K(label) == PARTITION)
		{
		zw = callocobject();
		erg += m_scalar_polynom(cons_eins,result);
		for (i=(INT)0; i<S_PA_LI(label); i++)
			{
			erg += compute_elmsym_with_alphabet(S_PA_I(label,i),
							          l,zw);
			erg += mult_apply(zw,result);
			}
		erg += SYMfreeall(zw);
		}
	else if (S_O_K(label) == ELM_SYM)
		{
		zw = callocobject();
		m_i_i((INT)0,result);
		z = label;
		while (z != NULL)
			{
			erg += compute_elmsym_with_alphabet(S_S_S(z),l,zw);
			erg += mult_apply(S_S_K(z),zw);
			erg += add_apply(zw,result);
			z = S_S_N(z);
			erg += freeself(zw);
			}
		erg += SYMfreeall(zw);
		}
	else    
		erg += WTO("compute_elmsym_with_alphabet:label",label);
		

rr:
	ENDR("compute_elmsym_with_alphabet");
}
#endif /* PARTTRUE */
#ifdef PARTTRUE
INT compute_power_with_alphabet(label,l,result) OP l,label,result;
/* AK 120391 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	INT i;
	OP zw,z;

	if (not EMPTYP(result)) 
		erg += freeself(result);
	if (S_O_K(label) == INTEGER)
		{
		erg += init(POLYNOM,result);
		for (i=(INT)0;i<S_I_I(l); i++)
			{
			zw = callocobject();
			erg += m_iindex_iexponent_monom(i,S_I_I(label),zw);
			insert(zw,result,NULL,NULL);
			}
		}
	else if (S_O_K(label) == PARTITION)
		{
		zw = callocobject();
		erg += m_scalar_polynom(cons_eins,result);
		for (i=(INT)0; i<S_PA_LI(label); i++)
			{
			erg += compute_power_with_alphabet(S_PA_I(label,i),
							          l,zw);
			erg += mult_apply(zw,result);
			}
		erg += SYMfreeall(zw);
		}
	else if (S_O_K(label) == POW_SYM)
		{
		zw = callocobject();
		m_i_i((INT)0,result);
		z = label;
		while (z != NULL)
			{
			erg += compute_power_with_alphabet(S_S_S(z),l,zw);
			erg += mult_apply(S_S_K(z),zw);
			erg += add_apply(zw,result);
			z = S_S_N(z);
			erg += freeself(zw);
			}
		erg += SYMfreeall(zw);
		}
	else    {
		printobjectkind(label);
		erg = error("compute_power_with_alphabet:wrong kind of label");
		}

	if (erg != OK)
		EDC("compute_power_with_alphabet");
	return erg;
}
#endif /* PARTTRUE */
#ifdef PARTTRUE
#ifdef SCHURTRUE
INT compute_schur_with_alphabet(part,l,res) OP part,res,l;
/* AK 101187 */
/* AK 161187 l ist die laenge des alphabets */
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 150591 V1.2 */
/* AK 200891 V1.3 */
/* AK 161195 much faster with m_umriss_tableaux etc. */
{
	OP e,d;
	INT erg = OK;
	INT i,eintrag;

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

	if (S_O_K(part) == PARTITION)
		{
		if (GR(S_PA_L(part),l))
			return M_I_I((INT)0,res);
		if (nullp(S_PA_L(part)))
			return M_I_I((INT)1,res);
		e=callocobject();
		erg += m_umriss_tableaux(part,l,e);
		erg += m_tableaux_polynom(e,res);
		erg += SYMfreeall(e);
		goto endr_ende;
		}
	else if (S_O_K(part) == SCHUR)
		{
		e=callocobject();
		d = part;
		while (d != NULL)
			{
			erg += compute_schur_with_alphabet(S_S_S(d),l,e);
			erg += mult_apply(S_S_K(d),e);
			erg += add_apply(e,res);
			d = S_S_N(d);
			}
		erg += SYMfreeall(e);
		goto endr_ende;
		}
	else
		{
		WTO("compute_schur_with_alphabet",part);
		goto endr_ende;
		}
	ENDR("compute_schur_with_alphabet");
}
#endif /* SCHURTRUE */
#endif /* PARTTRUE */

#ifdef SCHURTRUE
INT m_pa_s(part,schur) OP part, schur;
/* AK 090790 V1.1 */ /* AK 260291 V1.2 */ /* AK 050891 V1.3 */
{
	OP p;
	INT erg = OK;
	p = callocobject();
	erg += copy_partition(part,p);
	erg += b_pa_s(p,schur);
	ENDR("m_pa_s");
}

#endif /* SCHURTRUE */

INT b_pa_s(part,schur) OP part, schur;
/* AK 140687 */ /* erzeugt aus einer part eine schurfunction */
/* AK 110789 V1.0 */ /* AK 241189 V1.1 */ /* AK 200891 V1.3 */
{
#ifdef SCHURTRUE
	INT erg=OK;
	if (check_equal_2(part,schur,b_pa_s,&erg) == EQUAL)
                return erg;
	erg += b_skn_s(part,callocobject(),NULL,schur);
	erg += M_I_I((INT)1,S_S_K(schur));
	ENDR("b_pa_s");
#else
	return error("b_pa_s:SCHUR not available");
#endif /* SCHURTRUE */
}

#ifdef SCHURTRUE
INT m_v_s(vec,schur) OP vec, schur;
/* AK 110187 */
/* erzeugt aus einen vector eine schurfunction vec wird nicht freigegeben */
/* AK 110789 V1.0 */ /* AK 170590 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg=OK;
	erg += b_skn_s(	callocobject(), callocobject(),
	    NULL, schur);
	erg += m_v_pa(vec,S_S_S(schur));
	erg += M_I_I((INT)1,S_S_K(schur));
	return erg;
}
#endif /* SCHURTRUE */

INT add_monomial_monomial(a,b,c) OP a, b, c;
{
	return add_schur_schur_co(a,b,c,MONOMIAL);
}
INT add_elmsym_elmsym(a,b,c) OP a, b, c;
{
	return add_schur_schur_co(a,b,c,ELM_SYM);
}
INT add_powsym_powsym(a,b,c) OP a, b, c;
{
	return add_schur_schur_co(a,b,c,POW_SYM);
}

#ifdef HOMSYMTRUE 
INT add_homsym_homsym(a,b,c) OP a, b, c;
/* AK 200891 V1.3 */
{
	return add_schur_schur_co(a,b,c,HOM_SYM);
}
#endif /* HOMSYMTRUE */

#ifdef SCHURTRUE 
INT add_schur_schur(a,b,c) OP a, b, c;
/* AK 200891 V1.3 */
{
	return add_schur_schur_co(a,b,c,SCHUR);
}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
static INT add_schur_schur_co(a,b,c,typ) OP a, b, c;OBJECTKIND typ;
/* AK 110789 V1.0 */ /* AK 201289 V1.1 */ /* AK 050891 V1.3 */
{
	add_polynom_polynom(a,b,c); 
	if (listp(c))
		C_O_K(c,typ); 
	return(OK);
}
#endif /* SCHURTRUE */




#ifdef SCHURTRUE
INT m_skn_s(self,koeff,n,ergebnis) OP self,koeff,n,ergebnis;
/* AK 200891 V1.3 */
	{
	INT erg = OK;
	erg += m_skn_po(self,koeff,n,ergebnis);
	C_O_K(ergebnis,SCHUR);
	if (erg != OK) 		
		EDC("m_skn_s");
	return erg;
	}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT b_skn_s(self,koeff,n,ergebnis) OP self,koeff,n,ergebnis;
/* AK 110789 V1.0 */ /* AK 130391 V1.2 */
/* AK 130891 V1.3 */
{
	INT erg = OK;
	erg += b_skn_po(self,koeff,n,ergebnis);
	erg += C_O_K(ergebnis,SCHUR);
	if (erg != OK) 		
		EDC("b_skn_s");
	return erg;
}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT objectread_schur(filename,poly) OP poly; FILE *filename;
/* AK 291086 */ /* AK 110789 V1.0 */ /* AK 221289 V1.1 */
/* AK 200891 V1.3 */
{
	char antwort[2];
	INT erg = OK; /* AK 040893 */

	erg += b_skn_s(callocobject(), callocobject(), callocobject(), poly);
	erg += objectread(filename,PARTITION,S_S_S(poly));
	erg += objectread(filename,INTEGER,S_S_K(poly));
	fscanf(filename,"%s",antwort);
	if (antwort[0] == 'j') 		
		erg += objectread(filename,SCHUR,S_S_N(poly));
	else if (antwort[0] == 'n')     { 
		SYM_free(S_S_N(poly)); 
		C_S_N(poly,NULL); 
	}
	else 
		error("objectread_schur:wrong data");
	if (erg != OK)
		EDC("objectread_schur");
	return erg;
}

INT objectwrite_schur(filename,poly) FILE *filename; OP poly;
/* AK 291086 */ /* AK 110789 V1.0 */ /* AK 221289 V1.1 */
/* AK 200891 V1.3 */
{
	INT erg = OK;
	erg += objectwrite(filename,S_S_S(poly));
	erg += objectwrite(filename,S_S_K(poly));
	if (not lastp(poly))
	{ 
		fprintf(filename,"j\n"); 
		erg += objectwrite(filename,S_S_N(poly)); 
	}
	else fprintf(filename,"n\n");
	ENDR("objectwrite_schur");
}

INT scan_monomial(a) OP a; 
{
	printeingabe("Input of a monomial symmetric function");
	return scan_schur_co(a,MONOMIAL);
}
INT scan_elmsym(a) OP a; 
{
	printeingabe("Input of a elementary symmetric function");
	return scan_schur_co(a,ELM_SYM);
}
INT scan_powsym(a) OP a; 
{
	printeingabe("Input of a powersum symmetric function");
	return scan_schur_co(a,POW_SYM);
}
INT scan_homsym(a) OP a; 
{
	printeingabe("Input of a complete symmetric function");
	return scan_schur_co(a,HOM_SYM);
}
INT scan_schur(a) OP a; 
{
	printeingabe("Input of a Schur function");
	return scan_schur_co(a,SCHUR);
}
INT sscan_schur(t,a) char *t; OP a;
/* AK 171296 */
{
	INT i,n=1,erg = OK;
	OP c,d,e;
        char *v,*w;

	c = callocobject();
	d = callocobject();
	e = callocobject();m_i_i(1L,e);
	erg += init(SCHUR,a);
        v = t;
again:
	if (*v == '\0') goto sse;
        while (*v == ' ') v++;
	if (*v == '[') {
		i = sscan(v,PARTITION,c);
		if (i != OK) goto sse;
		while (*v != ']') v++;
		v++;
		erg += m_skn_s(c,e,NULL,d);
		erg += add_apply(d,a);
		m_i_i(1L,e);
		goto again;
		}
	else if (*v == '+') {
		v++; n=1;
		goto again;
		}
	else if (*v == '-') {
		v++; n= -1;
		goto again;
		}
	else if (SYM_isdigit(*v))
		{
		i = sscan(v,INTEGER,e);
		if (i != OK) goto sse;
		while (SYM_isdigit(*v)) v++;
		v++;
		if (n == -1) addinvers_apply(e);
		n=1;
		goto again;
		}
		
sse:
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	erg += SYMfreeall(e);
	ENDR("sscan_schur");

}

static INT scan_schur_co(a,typ) OP a; OBJECTKIND typ;
/* AK  for the input of a symmetric function (Schur etc.) */
/* AK 110789 V1.0 */ /* AK 221289 V1.1 */ /* AK 050891 V1.3 */

{
	char antwort[2];
	OBJECTKIND kind;
	INT erg=OK;
	OP d;

	erg += b_skn_s( callocobject(), callocobject(), NULL, a);
	C_O_K(a,typ);
	erg += printeingabe("Input of a partition type monom");
	erg += scan(PARTITION,S_S_S(a));
	erg += printeingabe("Input of coefficent");
	kind = scanobjectkind();
	erg += scan(kind,S_S_K(a));
	erg += printeingabe("one more monom y/n");
	scanf("%s",antwort);
	if (antwort[0]  == 'y') 		
		{
		d = callocobject();
		erg += scan_schur_co(d,typ);
		erg += insert(d,a,NULL,NULL); /* AK 091195 reihenfolge beliebig */
		}
	ENDR("scan_schur internal routine");
}
#endif

#ifdef SCHURTRUE
OP s_s_s(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_mo_s(s_l_s(a))); }

OP s_s_k(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_mo_k(s_l_s(a))); }

OP s_s_n(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_l_n(a)); }

OP s_s_si(a,i) OP a; INT i;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_pa_i(s_mo_s(s_l_s(a)),i)); }

OP s_s_sl(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_pa_l(s_mo_s(s_l_s(a)))); }

INT s_s_ki(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_mo_ki(s_l_s(a))); }

INT s_s_sii(a,i) OP a; INT i;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_pa_ii(s_mo_s(s_l_s(a)),i)); }


INT s_s_sli(a) OP a;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ return(s_pa_li(s_mo_s(s_l_s(a)))); }

INT c_s_n(a,b) OP a,b;
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 020791 V1.2 */
/* AK 200891 V1.3 */
{ 
	OBJECTSELF c; 
	c = s_o_s(a); 
	c.ob_list->l_next = b; 
	return(OK); 
}

INT b_sn_s(s,n,res) OP s,n,res;
{
	INT erg = OK;
	erg += b_sn_l(s,n,res);
	C_O_K(res,SCHUR);
	ENDR("b_sn_s");
}




INT test_schur()
/* AK 181289 V1.1 */ /* AK 020791 V1.2 */ /* AK 200891 V1.3 */
{
	OP a = callocobject();
	OP b = callocobject();
	OP c = callocobject();

	printeingabe("test_schur:scan(a)");
	scan(SCHUR,a);
	println(a);
	printeingabe("test_schur:copy(a,b)");
	copy(a,b);
	println(b);
	printeingabe("test_schur:add(a,b,b)");
	add(a,b,b);
	println(b);
	printeingabe("test_schur:mult(a,b,b)");
	mult(a,b,b);
	println(b);
	printeingabe("test_schur:addinvers(b,a)");
	addinvers(b,a);
	println(a);
	printeingabe("test_schur:mult_apply(b,a)");
	mult_apply(b,a);
	println(a);

	SYMfreeall(a);
	SYMfreeall(b);
	SYMfreeall(c);
	return(OK);
}




INT mult_schur_schur(a,zwei,c) OP a, zwei, c;
/* 221086 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 050891 V1.3 */
{
	OP y, einszeiger, zweizeiger;
	INT erg = OK;

	zweizeiger = zwei;
	while (zweizeiger != NULL)
	{
		einszeiger = a;
		while (einszeiger != NULL)
		{
			y = callocobject();
			erg += outerproduct_schur
			    (S_S_S(einszeiger), S_S_S(zweizeiger), y);
			erg += mult_apply(S_S_K(einszeiger),y);
			erg += mult_apply(S_S_K(zweizeiger),y);
			insert(y,c,add_koeff,comp_monomvector_monomvector);
			/* insert changed AK 111188 */
			einszeiger = S_S_N(einszeiger);
		};
		zweizeiger = S_S_N(zweizeiger);
	};
	ENDR("mult_schur_schur");
}


INT m_part_part_perm(a,b,c) OP a,b,c;
/* AK 050988 die permutation c zur multiplikation
zweier Schurfunktionen mit index a und b wird berechnet */
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
{
	OP d;
	OP z;
	INT i,j,k,l, erg = OK;
	CTO(PARTITION,"m_part_part_perm",a);
	CTO(PARTITION,"m_part_part_perm",b);
	d = callocobject();
	/* a ist laenge des vectors */
	k = S_PA_II(a,S_PA_LI(a)-1);
	l = S_PA_II(b,S_PA_LI(b)-1);
	erg += m_il_v( S_PA_LI(a) + S_PA_LI(b) + k + l  ,d);
	z = S_V_S(d);
	for (i=(INT)0; i< S_PA_LI(a); i++,z++) M_I_I(S_PA_II(a,i),z);
	for (j=(INT)0 ; j < k; j++,i++,z++) M_I_I((INT)0,z);
	for (j=(INT)0; j < S_PA_LI(b); j++,i++,z++) M_I_I(S_PA_II(b,j),z);
	for (j=(INT)0 ; j<l; j++,i++,z++) M_I_I((INT)0,z);
	erg += lehmercode_vector(d,c);
	erg += SYMfreeall(d);
	ENDR("m_part_part_perm");
}


INT outerproduct_schur(a,b,c) OP a, b, c;
/* AK 071086 */ /* AK 110789 V1.0 */ /* AK 181289 V1.1 */
/* AK 050891 V1.3 */
/* a:  PARTITION b: PARTITION c: wird SCHUR */
{
	INT erg = OK;
	OP   d;
	CTO(PARTITION,"outerproduct_schur",a);
	CTO(PARTITION,"outerproduct_schur",b);

	d=callocobject();
	erg += m_part_part_perm(a,b,d);
	erg += newtrans(d,c);
	erg += SYMfreeall(d); 

	ENDR("outerproduct_schur");
}



INT m_perm_schur(a,b) OP a,b;
/* AK 270788 */
/* zerlegt das Schubertpolynom X_a  in eine Summe
von Schurpolynomen */
/* AK 110789 V1.0 */ /* AK 181289 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	CTO(PERMUTATION,"m_perm_schur",a);
	erg += newtrans(a,b); 
	ENDR("m_perm_schur");
}


INT outerproduct_schur_limit_limitfunction(a,b,c,k,f,l) OP k, a, b, c,l;
	INT (*f)();
/* 071086 */ /* a b sind partitionen */ /* AK 071189  */
/* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
/* k ist ein limit fuer die groesse */
{
	OP   d=callocobject();
	INT erg = OK;
	if (not EMPTYP(c)) 
		erg += freeself(c);
	erg += m_part_part_perm(a,b,d);
	erg += newtrans_limit_limitfunction(d,c,k,f,l);
	erg += SYMfreeall(d);
	ENDR("outerproduct_schur_limit_limitfunction");
}

INT outerproduct_schur_limitfunction(a,b,c,f,l) OP a, b, c,l;
	INT (*f)();
/* 071086 */ /* a b sind partitionen */ /* AK 071189  */
/* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
{
	OP   d=callocobject();
	INT erg = OK;
	if (not EMPTYP(c)) 
		erg += freeself(c);
	erg += m_part_part_perm(a,b,d);
	erg += newtrans_limitfunction(d,c,f,l);
	erg += SYMfreeall(d);
	ENDR("outerproduct_schur_limitfunction");
}

INT outerproduct_schur_limit(a,b,c,l) OP a, b, c,l;
/* 071086 */ /* a b sind partitionen */ /* AK 071189  */
/* AK 181289 V1.1 */ /* AK 180391 V1.2 */ /* AK 200891 V1.3 */
{
	OP   d=callocobject();
	if (not EMPTYP(c)) 
		freeself(c);
	m_part_part_perm(a,b,d);
	newtrans_limitfunction(d,c,neqparts_partition,l);
	SYMfreeall(d);
	return(OK);
}




INT comp_colex_schurmonom(a,b) OP a,b;
/* AK 091189 */ /* AK V1.1 201189 */
/* AK 200891 V1.3 */
{
	INT erg = OK;
	CTO(MONOM,"comp_colex_schurmonom",a);
	CTO(MONOM,"comp_colex_schurmonom",b);
	return(comp_colex_part(S_MO_S(a),S_MO_S(b)));
	ENDR("comp_colex_schurmonom");
}
#endif /* SCHURTRUE */

#ifdef PARTTRUE
INT comp_colex_part(a,b) OP a,b;
/* a,b partitions colex order */
/* AK V1.1 151189 */ /* AK 200891 V1.3 */
{
	INT i = S_PA_LI(a)-(INT)1;
	INT j = S_PA_LI(b)-(INT)1;
	INT erg;

	if (S_O_K(a) != PARTITION) 
		error("comp_colex_part:kind != PARTITION");
	if (S_O_K(b) != PARTITION) 
		error("comp_colex_part:kind != PARTITION");
	

	for (;(i >= (INT)0) || (j>=(INT)0); i--,j--)
	{
		if (i<(INT)0) return((INT)1);
		if (j<(INT)0) return((INT)-1);
		erg = S_PA_II(a,i) - S_PA_II(b,j);
		if (erg <(INT)0) return((INT)1);
		if (erg >(INT)0) return((INT)-1);
	}
	return((INT)0);
}
#endif /* PARTTRUE */


#ifdef MATRIXTRUE
#ifdef SCHURTRUE
INT hall_littlewood_tafel(a,b) OP a,b;
/* AK 191289 a ist grad der sn b wird tafel */ /* AK 201289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i,j;
	OP c = callocobject();
	OP d = callocobject();
	OP z,zz;
	INT erg = OK;
	CTO(INTEGER,"hall_littlewood_tafel",a);
	erg += makevectorofpart(a,c);
	erg += m_ilih_nm(S_V_LI(c),S_V_LI(c),b);



	for (i=(INT)0;i<S_V_LI(c);i++)
	{
		erg += hall_littlewood(S_V_I(c,i),d);
		z = d;
		while (z != NULL) {
			zz = S_MO_S(S_L_S(z)); /* partition */
			for (j=0;j<S_V_LI(c);j++)
				if (EQ(zz,S_V_I(c,j))) break;
			erg += copy(S_MO_K(S_L_S(z)),S_M_IJ(b,i,j));
			/* koef sind polynom */
			z = S_L_N(z);
		}
	}

	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	ENDR("hall_littlewood_tafel");
}
#endif /* SCHURTRUE */
#endif /* MATRIXTRUE */

#ifdef SCHURTRUE
INT hall_littlewood_alt(a,b) OP a,b;
/* AK 191289 a ist partition 
b wird das zugehoerige hall littlewood polynom */
/* mittels d_ij = langsam */ /* schneller morris mit skew schur */
/* AK 201289 V1.1 */
/* AK 200891 V1.3 */
{
	INT i,j;
	OP c = callocobject();

	if (not EMPTYP(b)) 
		freeself(b);
	init_hall_littlewood(a,c);

	for (i = 0;i<S_PA_LI(a);i++)
		for (j = i+1;j<S_PA_LI(a);j++)
			hall_littlewood_dij(c,c,i,j);

	reorder_hall_littlewood(c,b);
	return SYMfreeall(c); 
}


INT init_hall_littlewood(a,b) OP a,b;
/* AK 200891 V1.3 */
{
	b_skn_s(callocobject(),callocobject(),NULL,b);
	copy_partition(a,S_S_S(b));
	m_skn_po(callocobject(),callocobject(),NULL,S_S_K(b));
	m_il_v((INT)1,S_PO_S(S_S_K(b)));
	M_I_I((INT)0,S_PO_SI(S_S_K(b),(INT)0));
	M_I_I((INT)1,S_PO_K(S_S_K(b)));
	return(OK);
}


INT reorder_hall_littlewood(a,b) OP a,b;
/* AK 191289 
es werden die partitionen wieder neu sortiert
in die ansteigende form */
/* a is SCHUR */
/* AK 200891 V1.3 */
{
	OP z = a,d,e;
	OP zzz;
	INT i,j;
	INT erg = OK;
	CTO(SCHUR,"reorder_hall_littlewood",a);
	CE2(a,b,reorder_hall_littlewood);
		
	init(SCHUR,b);
	while (z != NULL)
	{
		d = callocobject();
		erg += copy(S_L_S(z),d);
		zzz = S_MO_S(d); /* zzz ist partition */
re_again:
		for (i=1;i<S_PA_LI(zzz);i++)
		{
			
			if (S_PA_II(zzz,(INT)0) < (INT)0)
			{
				erg += SYMfreeall(d); 
				goto re_while_ende;
			}
			else if (S_PA_II(zzz,i) == S_PA_II(zzz,i-1) -1)
			{
				erg += SYMfreeall(d); 
				goto re_while_ende;
			}
			else if (S_PA_II(zzz,i) < S_PA_II(zzz,i-1) )
			{
				erg += addinvers_apply(S_MO_K(d));
				INC_INTEGER(S_PA_I(zzz,i));
				DEC_INTEGER(S_PA_I(zzz,i-1));
				erg += swap(S_PA_I(zzz,i),S_PA_I(zzz,i-1));
				goto re_again;
			}
		}
		for (i=(INT)0;i<S_PA_LI(zzz);i++) 
			if (S_PA_II(zzz,i)>(INT)0) break;
		/* noch nach links schieben */

		for (j=i;j<S_PA_LI(zzz);j++)
			M_I_I(S_PA_II(zzz,j),S_PA_I(zzz,j-i));

		if ((S_PA_LI(zzz)-i) == (INT)0) /* AK 300197 */
			{
			j = S_PA_II(zzz,(INT)0);
			erg += m_il_v((INT)1,S_PA_S(zzz));
			M_I_I(j,S_PA_I(zzz,(INT)0));
			}
		else if ((S_PA_LI(zzz)-i) == (INT)1) /* AK 121093 */
			{
			j = S_PA_II(zzz,(INT)0);
			erg += m_il_v((INT)1,S_PA_S(zzz));
			M_I_I(j,S_PA_I(zzz,(INT)0));
			}
		else 	{
			M_I_I(S_PA_LI(zzz)-i,S_PA_L(zzz));
			}
		
		e = callocobject();
		b_sn_s(d,NULL,e);
		erg += insert(e,b,NULL,NULL);
re_while_ende:
		z = S_L_N(z);
	}
	if (S_L_S(b) == NULL) 
		erg += freeself(b);
	ENDR("reorder_hall_littlewood");
}



INT hall_littlewood_dij(a,b,i,j) OP a,b; INT i,j;
/* AK 181289 
bei der berechnung von hall littlewood polynomen benoetigt
man die anwendung vomuliplikation mit
(1 + t * d_ij + t^2 * d_ij^2 ... )
eingabe: a = hall_littlewood polynom
	 i<j indices
ausgabe: b neues hall_littlewood polynom 
*/
/* hall littlewood polynome sind schurpolynome mit polynomen in t als koeff*/
/* AK 201289 V1.1 */
/* AK 200891 V1.3 */
{
	INT k,tt;
	OP sp = callocobject();
	OP z,zz,zzz;

	copy_list(a,sp); /* funktioniert auch beim 
				aufruf mit gleichen variablen */
	copy_list(sp,b); /* die multiplikation mit 1 */
	for (k=1;;k++)
	{
		tt = (INT)0;
		z = sp;
		while (z != NULL)
		{
			zz = S_L_S(z);
			zzz = S_MO_S(zz);
			if (j <= S_PA_LI(zzz)) /* index j zulaessig */
			if (S_PA_II(zzz,i) >= (k-i) ) {
				OP d = callocobject();
				OP e = callocobject();
				tt = (INT)1;
				copy(zz,d);
				M_I_I(S_PA_II(zzz,i)-k,S_PA_I(S_MO_S(d),i));
				M_I_I(S_PA_II(zzz,j)+k,S_PA_I(S_MO_S(d),j));
				b_skn_po(callocobject(),callocobject(),NULL,e);
				m_il_v((INT)1,S_PO_S(e));
				M_I_I(k,S_PO_SI(e,(INT)0));
				M_I_I((INT)1,S_PO_K(e)); /* e = t^k */
				mult(e,S_MO_K(d),S_MO_K(d));
			insert(d,b,add_koeff,comp_monomvector_monomvector);
				/* add(d,b,b);*/
				SYMfreeall(e);
			}
			z = S_L_N(z);
		}
		if (tt == (INT)0) break; /* ende */
	}
	SYMfreeall(sp);
	return(OK);
}
#endif /* SCHURTRUE */

INT tex_hall_littlewood(a) OP a;
/* AK 191289 tex ausgabe */
/* AK 200891 V1.3 */
{ 
	return tex(a); 
}


#ifdef SKEWPARTTRUE
#ifdef SCHURTRUE
INT m_skewpart_skewperm(a,b) OP a,b;
/* AK 221289 V1.1 */ /* AK 010791 V1.2 */
/* es wird die permutation fuer die berechnung der skew schur funktion
berechnet */
/* vgl. m_part_part_perm() */
/* AK 130891 V1.3 */
{
	OP d ; /* d wird der code vector */
	OP c ; /* c gewicht der kleineren partition */
	INT k,i,j,h;
	INT lg = S_SPA_GLI(a);
	INT lk = S_SPA_KLI(a); /* die laengen der beiden partitionen */
	INT erg = OK;

	d = callocobject();
	c = callocobject();

	erg += weight(S_SPA_K(a),c);
	k = S_PA_II(S_SPA_G(a),lg-(INT)1);
	/* k ist der letzte eintrag in der groesseren partition */
	erg += m_il_v(S_I_I(c) + k + S_PA_LI(S_SPA_G(a)),d);
	erg += SYMfreeall(c);
	for (i=(INT)0;i<lg-lk;i++) M_I_I(S_SPA_GII(a,i),S_V_I(d,i));
	/* zuerst werden die teile aus der grossen partition kopiert */
	h = i; /* h ist laufindex durch vector */
	/* i ist laufindex durch grosse partition j durch kleine */
	for (j=(INT)0;j<lk;j++,i++,h++)
	{
		if (j==(INT)0) /* error in version < 010791 */
			for (k=(INT)0;k<S_SPA_KII(a,j);k++,h++)
				M_I_I((INT)0,S_V_I(d,h));
		else
			for (k=(INT)0;k<S_SPA_KII(a,j)-S_SPA_KII(a,j-(INT)1);k++,h++)
				M_I_I((INT)0,S_V_I(d,h));
		M_I_I(S_SPA_GII(a,i)-S_SPA_KII(a,j),S_V_I(d,h));
	}
	for (;h<S_V_LI(d);h++) 
		M_I_I((INT)0,S_V_I(d,h));
	erg += lehmercode_vector(d,b);
	erg += SYMfreeall(d);
	ENDR("m_skewpart_skewperm");
}
#endif /* SCHURTRUE */
#endif /* SKEWPARTTRUE */

#ifdef SCHURTRUE
#ifdef SKEWPARTTRUE
INT part_part_skewschur(a,b,c) OP a,b,c;
/* AK 221289 V1.1 */ /* AK 010791 V1.2 */
/* a ist die groessere partition */
/* AK 130891 V1.3 */
{
	OP d,e;
	INT i,j;
	INT erg = OK;

	if (not EMPTYP(c)) 
		freeself(c);
	i = S_PA_LI(a)-1;
	j = S_PA_LI(b)-1;
	if (j > i) {
			/* result is empty object */
			goto endr_ende;
			}
	for(;j>=0;j--,i--)
		if (S_PA_II(a,i) < S_PA_II(b,j)) 
			{
			/* result is empty object */
			goto endr_ende;
			}
	/* zuerst test ob b kleiner a */
	/* falls nicht ist das ergebnis ein leeres object */
	d = callocobject();
	e = callocobject();
	erg += b_gk_spa(callocobject(),callocobject(),d);
	erg += copy_partition(a,S_SPA_G(d));
	erg += copy_partition(b,S_SPA_K(d));
	erg += m_skewpart_skewperm(d,e);
	erg += newtrans(e,c);
	erg += SYMfreeall(d); 
	erg += SYMfreeall(e); 
	ENDR("part_part_skewschur");
}
#endif /* SKEWPARTTRUE */
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
#ifdef SKEWPARTTRUE

INT hall_littlewood(a,b) OP a,b;
/* AK 221289 V1.1 die zweite methode, siehe morris 1963 */
/* Math. Zeit 81 112-123 (1963) */
/* AK 200891 V1.3 */
{
	OP c,d,e,ff,g,z,zz;
	INT erg = OK; /* AK 180893 */
	INT i;
	CE2(a,b,hall_littlewood);
	CTO(PARTITION,"hall_littlewood",a);
	if (S_PA_LI(a) == (INT)1) 
		{
		erg += b_skn_s(callocobject(),callocobject(),NULL,b);
		erg += copy(a,S_S_S(b));
		erg += b_skn_po(callocobject(),callocobject(),NULL,S_S_K(b));
		erg += M_I_I((INT)1,S_PO_K(S_S_K(b)));
		erg += m_il_v((INT)1,S_PO_S(S_S_K(b)));
		erg += M_I_I((INT)0,S_PO_SI(S_S_K(b),(INT)0));
		goto hl_ende;
		}
	/* wenn die laenge groesser 1 ist */

	erg += init(SCHUR,b);

	c = callocobject(); d = callocobject(); e = callocobject(); g = callocobject();

	erg += copy_partition(a,c); 
	erg += dec_partition(c);
	erg += hall_littlewood(c,d);
	erg += weight_partition(c,e);
	erg += copy(d,c);
	z = c; 
	while (z != NULL)
		{
		erg += inc_partition(S_S_S(z));
		M_I_I(	S_PA_II(a,S_PA_LI(a)-(INT)1), S_S_SI(z,S_S_SLI(z)-(INT)1));
		z = S_S_N(z);
		}

	ff = callocobject();
	erg += reorder_hall_littlewood(c,ff);
	insert(ff,b,NULL,NULL);

	erg += copy(d,c);
	for (i=(INT)1;i<=S_I_I(e); i++)
		{
		erg += m_i_pa(e,g);
		M_I_I(i,S_PA_I(g,(INT)0));
		z = c; /* c ist das ergebnis der rekursion */
		erg += init(SCHUR,d);
		while (z != NULL)
			{
			ff = callocobject();
			erg += part_part_skewschur(S_S_S(z),g,ff);
			if (not EMPTYP(ff)) 
				{
				zz = ff;
				while (zz != NULL) {
					erg += mult_apply(S_S_K(z),S_S_K(zz));
					zz = S_S_N(zz); 
					}
				erg += insert(ff,d,NULL,NULL);
				}
			else 
				erg += SYMfreeall(ff);
			z = S_S_N(z);
			}
	/* d ist nun die liste mit den expansion der skewpartition */
		z = d; 
	/* nun noch die multiplikation mit t^i */
		erg += b_skn_po(callocobject(),callocobject(),NULL,g);
		M_I_I((INT)1,S_PO_K(g));
		erg += m_il_v((INT)1,S_PO_S(g));
		M_I_I(i,S_PO_SI(g,(INT)0));
		while (z != NULL)
			{
			erg += inc_partition(S_S_S(z));
			M_I_I(S_PA_II(a,S_PA_LI(a)-(INT)1)+i, S_S_SI(z,S_S_SLI(z)-(INT)1));
			erg += mult_apply(g,S_S_K(z));
			z = S_S_N(z);
			}

		ff = callocobject();
		erg += reorder_hall_littlewood(d,ff);
		erg += insert(ff,b,NULL,NULL);
		}
	erg += SYMfreeall(e); 
	erg += SYMfreeall(d); 
	erg += SYMfreeall(c);
	erg += SYMfreeall(g);
hl_ende:
	ENDR("hall_littlewood");
}
#endif /* SKEWPARTTRUE */
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT add_apply_symfunc_symfunc(a,b) OP a,b;
/* AK 200891 V1.3 */
	{
	OP c = callocobject();
	copy_polynom(a,c);
	return(insert(c,b,add_koeff,comp_monomvector_monomvector));
	}



INT add_apply_symfunc(a,b) OP a,b;
/* AK 220390 V1.1 */ /* AK 200891 V1.3 */
{
	if (EMPTYP(b)) return(copy_polynom(a,b));
	if (S_O_K(a) == S_O_K(b))
		return add_apply_symfunc_symfunc(a,b);
	else 
		return co_sy_sy_co(a,b,b,add);
		
}


INT dimension_schur(a,b) OP a,b;
/* computes the dimension of the corresponding representation */
/* AK 020890 V1.1 */ /* AK 200891 V1.3 */
{
	OP z = a;
	OP erg = callocobject();
	m_i_i((INT)0,b); /* frees b */
	while (z != NULL)
		{
		dimension(S_S_S(z),erg);
		add(erg,b,b);
		z = S_S_N(z);
		}
	SYMfreeall(erg);return OK;
}




INT add_staircase_part(a,n,b) OP a,n,b;
/* adds the vector 0,1,...,n-1 to the partition a */
/* AK 050990 V1.1 */
/* AK 200891 V1.3 */
	{
	OP c = callocobject();
	INT i,j;
	m_l_v(n,c);
	for (i=S_V_LI(c)-(INT)1,j=S_PA_LI(a)-(INT)1;i>=(INT)0;i--,j--)
		if (j>=(INT)0) M_I_I(S_PA_II(a,j)+i,S_V_I(c,i));
		else M_I_I(i,S_V_I(c,i));
	if (not EMPTYP(b)) freeself(b);
	b_ks_pa(VECTOR,c,b);
	return OK;
	}



INT mod_part(a,b,c) OP a,b,c;
/* the single parts of partition a mod b gives c */
/* AK 050990 V1.1 */
/* AK 200891 V1.3 */
	{
	INT i;
	if (a != c) copy(a,c);
	for (i=0;i<S_PA_LI(c);i++)
		M_I_I(S_PA_II(c,i) % S_I_I(b), S_PA_I(c,i));
	return OK;
	}



INT p_root_schur(a,n,p,b) OP a,n,p,b;
/* a ist schur n ist integer p ist integer b wird schur */
/* AK 050990 V1.1 */
/* wie folgt wird gerechnet: addiere 0,..,n-2,n-1 zu den
partitionen, die die laenger als n sind werden gestrichen,
dann die partition modulo p, dann wieder zu aufsteigenden
partitionen um sortieren */
/*dies entspricht dem einsetzen von p-ten einheitswurzeln */
/* AK 200891 V1.3 */
	{
	OP z,c,d;
	if (a == b ) { c = callocobject(); copy(a,c);
		p_root_schur(c,n,p,b); SYMfreeall(c); return OK; }

	z = a;
	if (not EMPTYP(b) ) 
		freeself(b);
	b_sn_s(NULL,NULL,b);

	while (z != NULL)
		{
		if (S_S_SLI(z) <= S_I_I(n)) 
			{
			c = callocobject();
			d = callocobject();
			p_root_part(S_S_S(z),n,p,c);
			b_skn_s(c,callocobject(),NULL,d);
			copy(S_S_K(z),S_S_K(d));
			insert(d,b,NULL,NULL);
			}
		z = S_S_N(z);
		}
	reorder_hall_littlewood(b,b);
	return OK;
	}



INT p_root_part(a,n,p,b) OP a,n,p,b;
/* a ist part, n ist integer, p ist integer */
/* AK 050990 V1.1 */
/* AK 200891 V1.3 */
	{
	INT i;
	OP c = callocobject();
	m_l_v(n,c);
	for (i=(INT)0; i<S_V_LI(c); i++) M_I_I(i,S_V_I(c,i));
	add_staircase_part(a,n,b);
	mod_part(b,p,b); 
	sub(S_PA_S(b),c,S_PA_S(b));
	SYMfreeall(c); return OK;
	}



static INT m_int_qelm(a,b) INT a; OP b;
{
	INT erg = OK;
	erg += b_skn_e(callocobject(),callocobject(),NULL,b);
	erg += m_i_i(1L , S_S_K(b));
	erg += m_int_pa(a,S_S_S(b));
	ENDR("m_int_qelm");
}
static INT m_int_int_qelm(a,b,d) INT a,b; OP d;
{
	OP c = callocobject();
	INT erg = OK;
	if (a>b) error("::");
	erg += b_ks_pa(VECTOR,callocobject(),c);
	erg += m_il_v(2L,S_PA_S(c));
	erg += m_i_i(a,S_PA_I(c,0));
	erg += m_i_i(b,S_PA_I(c,1));
	erg += m_part_qelm(c,d);
	erg += SYMfreeall(c);
	ENDR("m_int_int_qelm");
		
}

INT m_part_qelm(a,b) OP a,b;
/* AK 060995 */
/* computes q polynomial as elmsym */
{
	INT i,j;
	OP c,d,e;
	INT erg = OK;

	CTO(PARTITION,"m_part_qelm",a);
	if (S_PA_LI(a) == 1) 
		{
		erg += m_int_qelm(S_PA_II(a,0),b);
		}
	else if (S_PA_LI(a) == 2)
		{
		c = callocobject();
		erg += m_int_qelm(S_PA_II(a,0),c);
		d = callocobject();
		erg += m_int_qelm(S_PA_II(a,1),d);
		erg += mult(c,d,b);
		e = callocobject();
		for (i=1;i<=S_PA_II(a,0);i++)
			{
			erg += m_int_qelm(S_PA_II(a,0)-i,c);
			erg += m_int_qelm(S_PA_II(a,1)+i,d);
			erg += mult(c,d,e);
			erg += mult_apply(cons_zwei,e);
			if (i%2 == 1)
				erg += mult_apply(cons_negeins,e);
			erg += add_apply(e,b);
			}
		erg += SYMfreeall(c);
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		}
	else if  (S_PA_LI(a) %2 == 0)
		{
		c = callocobject();
		erg += m_ilih_m(S_PA_LI(a), S_PA_LI(a),c);
		for (i=0;i<S_M_HI(c);i++)
			for (j=i+1;j<S_M_LI(c);j++)
				{
				m_int_int_qelm(S_PA_II(a,S_PA_LI(a)-1-j),
					S_PA_II(a,S_PA_LI(a)-1-i),S_M_IJ(c,i,j));
				}
		pfaffian_matrix(c,b);
		erg += SYMfreeall(c);
		}
	else	{
		d = callocobject();
		b_ks_pa(VECTOR,callocobject(),d);
		m_il_nv(S_PA_LI(a)+1,S_PA_S(d));
		for (i=0;i<S_PA_LI(a);i++)
			M_I_I(S_PA_II(a,i),S_PA_I(d,i+1));
		
		c = callocobject();
		erg += m_ilih_m(S_PA_LI(d), S_PA_LI(d),c);
		for (i=0;i<S_M_HI(c);i++)
			for (j=i+1;j<S_M_LI(c);j++)
				{
				m_int_int_qelm(S_PA_II(d,S_PA_LI(d)-1-j),
					S_PA_II(d,S_PA_LI(d)-1-i),S_M_IJ(c,i,j));
				}
		pfaffian_matrix(c,b);
		erg += SYMfreeall(c);
		SYMfreeall(d);
		}
	ENDR("m_part_qelm");
}

INT m_i_elmsym(a,b) INT a; OP b;
/* changes a INT into a ELMSYMpolynomial with this INT as 
koeffizent and labeled by the part with one zero part */
/* AK 060995 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += m_i_i(a,c); 
	erg += m_scalar_elmsym(c,b); 
	erg += SYMfreeall(c);
	ENDR("m_i_elmsym");
}

INT m_i_schur(a,b) INT a; OP b;
/* changes a INT into a SCHURpolynomial with this INT as 
koeffizent and labeled by the part with one zero part */
/* AK 181290 V1.1 */
/* AK 200891 V1.3 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += m_i_i(a,c); 
	erg += m_scalar_schur(c,b); 
	erg += SYMfreeall(c);
	ENDR("m_i_schur");
}



INT m_scalar_elmsym(a,b)  OP a,b;
/* changes a scalar into a ELMSYMpolynomial with this scalar as 
koeffizent and labeled by the part with one zero part */
/* AK 060995 */
{
	INT erg = OK;
	CE2(a,b,m_scalar_elmsym);
	erg += b_skn_e(callocobject(),callocobject(),NULL,b);
	erg += copy(a,S_SCH_K(b));
	erg += b_ks_pa(VECTOR,callocobject(),S_SCH_S(b));
	erg += m_il_v((INT)1,S_PA_S(S_S_S(b)));
	M_I_I((INT)0,S_PA_I(S_S_S(b),(INT)0));
	ENDR("m_scalar_elmsym");
}

INT m_scalar_schur(a,b)  OP a,b;
/* changes a scalar into a SCHURpolynomial with this scalar as 
koeffizent and labeled by the part with one zero part */
/* AK 181290 V1.1 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	CE2(a,b,m_scalar_schur);
	erg += b_skn_s(callocobject(),callocobject(),NULL,b);
	erg += copy(a,S_S_K(b));
	erg += b_ks_pa(VECTOR,callocobject(),S_S_S(b));
	erg += m_il_v((INT)1,S_PA_S(S_S_S(b)));
	M_I_I((INT)0,S_PA_I(S_S_S(b),(INT)0));
	ENDR("m_scalar_schur");
}


INT mult_power_schur(a,b,c) OP a,b,c;
/* a is INTEGER, PARTITION  b is SCHUR c becomes SCHUR */
/* AK 200891 V1.3 */
{
	OP z; OP d; INT i;
	INT erg = OK;
	CE3(a,b,c,mult_power_schur);
	erg += init(SCHUR,c);
	switch (S_O_K(a)) {
	case INTEGER:
		z = b;
		while (z != NULL)
			{
			d = callocobject();
			erg += mult_power_part(a,S_S_S(z),d);
			erg += mult_apply(S_S_K(z),d);
			erg += insert(d,c,NULL,NULL);
			z = S_S_N(z);
			}
		break;
	case PARTITION:
		erg += copy(b,c);
		for (i=0;i<S_PA_LI(a); i++)
			erg += mult_power_schur(S_PA_I(a,i),c,c);	
		break;
	case POW_SYM:
		z = a;
		while (z != NULL)
			{
			d = callocobject();
			erg += mult_power_schur(S_S_S(z),b,d);
			erg += mult_apply(S_S_K(z),d);
			erg += insert(d,c,NULL,NULL);
			z = S_S_N(z);
			}
		break;
	default:
		erg += WTT("mult_power_schur",a,b);
		break;
	}
	ENDR("mult_power_schur");
}



static INT mult_power_part(a,b,c) OP a,b,c;
/* a is INTEGER b is PARTITION c becomes SCHUR */
/* AK 200891 V1.3 */
{
	OP d,e;
	INT i,j;
	INT erg=OK;
	e = callocobject();
	erg += init(SCHUR,e);
	for (i=(INT)0; i<S_I_I(a)+S_PA_LI(b); i++)
		{
		d = callocobject();
		erg += b_skn_s(callocobject(),callocobject(),NULL,d);
		erg += M_I_I((INT)1,S_S_K(d));
		erg += b_ks_pa(VECTOR,callocobject(),S_S_S(d));
		erg += m_il_v(S_I_I(a)+S_PA_LI(b),S_PA_S(S_S_S(d)));
		for (j=(INT)0;j<S_I_I(a);j++)
			erg += M_I_I((INT)0,S_S_SI(d,j));
		for (j=(INT)0;j<S_PA_LI(b);j++)
			erg += M_I_I(S_PA_II(b,j),S_S_SI(d,j+S_I_I(a)));
		/* now we have copied the partition with leading zeros */
		erg += M_I_I(S_I_I(a)+S_S_SII(d,i),S_S_SI(d,i));
		insert(d,e,NULL,NULL);
		}
	erg += reorder_hall_littlewood(e,c);
	erg += SYMfreeall(e);
	ENDR("mult_power_part");
}



INT add_schur(a,b,d) OP a,b,d;
/* AK 050891 V1.3 */
{
	INT erg = OK;

	CTO(SCHUR,"add_schur",a);
	switch(S_O_K(b))
	{
	case INTEGER: /* AK 210891 */
		if (S_I_I(b) == (INT)0) 
			erg += copy(a,d);	
		else 
			erg += WTT("add_schur",a,b);
		break;
	case MONOM: 
		erg += add_monom_schur(b,a,d);
		break;
	case PARTITION : 
		erg += m_pa_s(b,d);
			
		erg += add_apply(a,d,d);
		break;
	case SCHUR : 
		erg += add_schur_schur(a,b,d);
		break;
	default :
		erg += WTT("add_schur",a,b);
	};

	ENDR("add_schur");
}
#endif /* SCHURTRUE */

#ifdef HOMSYMTRUE
INT add_homsym(a,b,d) OP a,b,d;
/* AK 050891 V1.3 */
{
	INT erg = OK;
	switch(S_O_K(b))
		{
		case MONOM: 
			erg += add_monom_homsym(b,a,d);
			break;
		case PARTITION : 
			erg += m_pa_h(b,d);
			erg += add_apply(a,d);
			break;
		case HOM_SYM : 
			erg += add_homsym_homsym(a,b,d);
			break;
		default :
			erg += WTT("add_homsym",a,b);
			break;
		};
	ENDR("add_homsym");
}
#endif /* HOMSYMTRUE */

#ifdef ELMSYMTRUE
INT add_elmsym(a,b,d) OP a,b,d;
/* AK 080992 */
{
	INT erg = OK;

	switch(S_O_K(b))
	{
	case MONOM: erg += add_monom_elmsym(b,a,d);break;
	case PARTITION : erg += m_pa_e(b,d);
			erg += add(a,d,d);break;
	case ELM_SYM : erg += add_elmsym_elmsym(a,b,d);break;
	default :
				erg += WTT("add_elmsym",a,b);
				break;
	};
	ENDR("add_elmsym");
}
#endif /* ELMSYMTRUE */

#ifdef POWSYMTRUE
INT add_powsym(a,b,d) OP a,b,d;
/* AK 080992 */
{
	INT erg = OK;

	switch(S_O_K(b))
		{
		case MONOM: erg += add_monom_homsym(b,a,d);break;
		case PARTITION : erg += m_pa_h(b,d);
				erg += add(a,d,d);break;
		case POW_SYM : erg += add_powsym_powsym(a,b,d);break;
		default :
			{
				printobjectkind(b);
				erg +=  error("add_powsym:wrong second type");
				break;
			}
		};
	ENDR("add_powsym");
}
#endif /* POWSYMTRUE */
#ifdef MONOMIALTRUE
INT add_monomial(a,b,d) OP a,b,d;
/* AK 080992 */
{
	INT erg = OK;

		switch(S_O_K(b))
		{
/*
		case MONOM: erg += add_monom_homsym(b,a,d);break;
		case PARTITION : erg += m_pa_h(b,d);
				erg += add(a,d,d);break;
*/
		case MONOMIAL : erg += add_monomial_monomial(a,b,d);break;
		default :
			{
				printobjectkind(b);
				erg +=  error("add_monomial:wrong second type");
				break;
			}
		};
	ENDR("add_monomial");
}
#endif /* MONOMIALTRUE */
#ifdef SCHURTRUE
INT mult_schur(a,b,d) OP a,b,d;
/* AK 050891 V1.3 */
{
	INT erg = OK;
	switch(S_O_K(b))
		{
		case CYCLOTOMIC: /* AK 260991 */
		case SQ_RADICAL: /* AK 260991 */
		case POLYNOM: /* AK 260991 */
		case LONGINT: /* AK 260991 */
		case BRUCH:
		case FF: /* AK 031193 */
		case INTEGER:  erg+= mult_scalar_schur(b, a, d);
				break;
		case SCHUR:  erg+=mult_schur_schur(a, b, d);
				break;
		case MONOM: /* AK 070995 */
				erg += copy(b,d);
				erg += mult_schur(a,S_MO_K(b),S_MO_K(d));
				break;
		case POW_SYM:
			erg += mult_power_schur(b,a,d);
			break;
		default: 
			erg += mult_symfunc(a,b,d);
			break;
		};
	ENDR("mult_schur");
}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT mult_symfunc_symfunc(a,b,d) OP a,b,d;
/* AK 200891 V1.3 */
{
	OP z = a,y,c;
	INT erg = OK;
	OBJECTKIND t = S_O_K(a);

	init(t,d);
	while (z != NULL)
		{
		y = b;
		while (y != NULL)
			{
			c = callocobject();
			erg += b_skn_s(callocobject(),callocobject(),NULL,c);
			C_O_K(c,t);
			erg += mult(S_S_K(y),S_S_K(z),S_S_K(c));
			erg += append(S_S_S(y),S_S_S(z),S_S_S(c));
			insert(c,d,NULL,NULL);
			y = S_S_N(y);
			}
		z = S_S_N(z);
		}

	return erg;
}



INT mult_symfunc(a,b,d) OP a,b,d;
{
	INT erg = OK;
	if (S_O_K(a) == SCHUR) {
		if (S_O_K(b) == POW_SYM) {
			erg += mult_power_schur(b,a,d);
			goto endr_ende; }
		}
	else if (S_O_K(a) == POW_SYM) {
		if (S_O_K(b) == SCHUR) {
			erg += mult_power_schur(a,b,d);
			goto endr_ende; }
		}
	switch(S_O_K(b))
		{

		case BRUCH:
		case CYCLOTOMIC:
		case SQ_RADICAL:
		case FF: /* AK 031193 */
		case POLYNOM: /* AK 031193 */
		case LONGINT:
		case INTEGER:  erg+= mult_scalar_polynom(b, a, d);break;

		case MATRIX:   erg+= mult_scalar_matrix(a,b,d); break;
		case MONOM:	 /* AK 031193 */
				erg += copy(b,d);
				erg += mult(a,S_MO_K(b),S_MO_K(d));
				break;

		case MONOMIAL: /* AK 040194 */
				erg += co_sy_sy_co(a,b,d,mult);
				if (S_O_K(a) == S_O_K(b))
					t_SCHUR_MONOMIAL(d,d);
				break;
		case HOM_SYM:
		case SCHUR:			
		case POW_SYM:
		case ELM_SYM:  if (S_O_K(a) == S_O_K(b))
				{
				erg+=mult_symfunc_symfunc(a, b, d);break;
				}
				else /* AK 031193 */
				{
				erg += co_sy_sy_co(a,b,d,mult); break;
				}
			
	
		default:   /* else fuer obiges */
				erg += WTT("mult_symfunc",a,b);
				break;
		};
	ENDR("mult_symfunc");
}

static INT co_sy_sy_co(a,b,d,fu) OP a,b,d; INT (*fu)();
/* a b are diff sym functions */ /* AK 031193 */
{
	OP e,f;
	INT erg = OK;
	e = callocobject();
	f = callocobject();
	if (S_O_K(a) == HOM_SYM) erg +=  t_HOMSYM_SCHUR(a,e);
	else if (S_O_K(a) == POW_SYM) erg +=  t_POWSYM_SCHUR(a,e);
	else if (S_O_K(a) == ELM_SYM) erg +=  t_ELMSYM_SCHUR(a,e);
	else if (S_O_K(a) == MONOMIAL) erg +=  t_MONOMIAL_SCHUR(a,e);
#ifdef UNDEF
	else if (S_O_K(a) == SCHUR)  /* OK */ ;
	else erg += WTT("SR9",a,b);
#endif
	else erg += copy(a,e);
	if (S_O_K(b) == HOM_SYM) erg +=  t_HOMSYM_SCHUR(b,f);
	else if (S_O_K(b) == POW_SYM) erg +=  t_POWSYM_SCHUR(b,f);
	else if (S_O_K(b) == ELM_SYM) erg +=  t_ELMSYM_SCHUR(b,f);
	else if (S_O_K(b) == MONOMIAL) erg +=  t_MONOMIAL_SCHUR(b,f);
#ifdef UNDEF
	else if (S_O_K(b) == SCHUR)  /* OK */ ;
	else erg += WTT("SR10",a,b);
#endif
	else erg += copy(b,f);
	erg += (*fu)(e,f,d);
	erg += SYMfreeall(e);
	erg += SYMfreeall(f);
	ENDR("internal function:SR11");
}
#endif /* SCHURTRUE */

#ifdef SCHURTRUE
INT t_SCHUR_MONOMIAL(a,b) OP a,b;
/* AK 261092 */
{
	OP c,d,e,f;
	INT i,j;
	INT erg = OK;

	CE2(a,b,t_SCHUR_MONOMIAL);
	if (S_O_K(a) == PARTITION)
		{
		c = callocobject(); d = callocobject();
		e = callocobject(); f = callocobject();
		erg += weight(a,c);
		erg += kostka_tafel(c,d);
		j = indexofpart(a);
		erg += makevectorofpart(c,f);
		erg += init(MONOMIAL,b);
		for (i=j;i<S_M_HI(d);i++)
			{
			if (not nullp(S_M_IJ(d,i,j)))
				{
				erg += m_skn_mon(S_V_I(f,i),S_M_IJ(d,i,j),NULL,e);
				erg += add_apply(e,b);
				}
			}
		erg += SYMfreeall(c); 
		erg += SYMfreeall(d); 
		erg += SYMfreeall(e); 
		erg += SYMfreeall(f);
		}
	else if (S_O_K(a) == SCHUR)
		{
		c = a;
		erg += init(MONOMIAL,b);
		if (S_L_S(a) == NULL)
			{
			goto endr_ende;
			}
		d = callocobject();
		while (c != NULL)
			{
			erg += t_SCHUR_MONOMIAL(S_S_S(c),d);
			erg += mult_apply(S_S_K(c),d);
			erg += add_apply(d,b);
			c = S_S_N(c);
			}
		erg += SYMfreeall(d);
		}
	else	{
		WTO("t_SCHUR_MONOMIAL",a);
		}
	ENDR("t_SCHUR_MONOMIAL");
}



INT t_MONOMIAL_SCHUR(a,b) OP a,b;
/* AK 261092 */
{
	OP c,d,e,f;
	INT i,j;
	INT erg = OK;

	CE2(a,b,t_MONOMIAL_SCHUR);
	if (S_O_K(a) == PARTITION)
		{
		c = callocobject(); 
		d = callocobject();
		e = callocobject(); 
		f = callocobject();
		erg += weight(a,c);
		if (nullp(c)) 
			{
			erg += m_skn_s(a,cons_eins,NULL,b);
			goto eee;
			}
		erg += kostka_tafel(c,d);
		erg += invers(d,d);
		j = indexofpart(a);
		erg += makevectorofpart(c,f);
		erg += init(SCHUR,b);
		for (i=j;i<S_M_HI(d);i++)
			{
			if (not nullp(S_M_IJ(d,i,j)))
				{
				erg += m_skn_s(S_V_I(f,i),S_M_IJ(d,i,j),NULL,e);
				erg += add_apply(e,b);
				}
			}
eee:
		erg += SYMfreeall(c); 
		erg += SYMfreeall(d); 
		erg += SYMfreeall(e); 
		erg += SYMfreeall(f);
		}
	else if (S_O_K(a) == MONOMIAL)
		{
		c = a;
		erg += init(SCHUR,b);
		if (S_L_S(a) == NULL)
			{
			goto endr_ende;
			}
		d = callocobject();
		while (c != NULL)
			{
			erg += t_MONOMIAL_SCHUR(S_S_S(c),d);
			erg += mult_apply(S_S_K(c),d);
			erg += add_apply(d,b);
			c = S_S_N(c);
			}
		erg += SYMfreeall(d);
		}
	else	{
		printobjectkind(a);
		erg += error("t_MONOMIAL_SCHUR:wrong input type");
		}
	ENDR("t_MONOMIAL_SCHUR");
}



INT t_HOMSYM_SCHUR(a,b) OP a,b;
/* AK 281092 */
{
	OP c,d;
	INT i,j;
	INT erg = OK;

	if (check_equal_2(a,b,t_HOMSYM_SCHUR,&erg) == EQUAL)
                return erg;
	if (S_O_K(a) == PARTITION)
		{
		/* es wird die passende permutation fuer die 
			multiplikation der bestandteile aufgebaut */
		c = callocobject();
		d = callocobject();
		weight(a,c); add(c,c,c); add_apply(S_PA_L(a),c);
		m_l_nv(c,d);
		for (i=(INT)0,j=(INT)0;i<S_PA_LI(a);i++)
			{
			m_i_i(S_PA_II(a,i),S_V_I(d,j));
			j=j+(INT)1+S_PA_II(a,i);
			}
		lehmercode(d,c); 
		newtrans(c,b);
		SYMfreeall(c);
		SYMfreeall(d);
		return OK;
		}
	else if(S_O_K(a) == HOM_SYM)
		{
		init(SCHUR,b);
		if (S_L_S(a) == NULL)
			return OK;
		c = a;
		d = callocobject();
		while (c != NULL)
			{
			t_HOMSYM_SCHUR(S_S_S(c),d);
			mult_apply(S_S_K(c),d);
			add_apply(d,b);
			c = S_S_N(c);
			}
		SYMfreeall(d);
		return OK;
		}
	else	{
		printobjectkind(a);
		error("t_HOMSYM_SCHUR:wrong input type");
		return ERROR;
		}
}




INT t_ELMSYM_SCHUR(a,b) OP a,b;
/* AK 281092 */
{
	OP c,d,e;
	INT i,j,k;
	INT erg = OK;

	if (check_equal_2(a,b,t_ELMSYM_SCHUR,&erg) == EQUAL)
                return erg;
	if (S_O_K(a) == PARTITION)
		{
		/* es wird die passende permutation fuer die 
			multiplikation der bestandteile aufgebaut */
		c = callocobject();
		d = callocobject();
		erg += weight(a,c); 
		erg += add(c,c,c); 
		erg += add_apply(S_PA_L(a),c);
		erg += m_l_nv(c,d);
		for (i=(INT)0,j=(INT)0;i<S_PA_LI(a);i++)
			{
			for (k=(INT)0;k<S_PA_II(a,i);k++,j++)
				M_I_I((INT)1,S_V_I(d,j));
			j++;
			}
		erg += lehmercode(d,c); 
		erg += newtrans(c,b);
		erg += SYMfreeall(c);
		erg += SYMfreeall(d);
		return erg;
		}
	else if(S_O_K(a) == ELM_SYM)
		{
		erg += init(SCHUR,b);
		if (S_L_S(a) == NULL)
			return erg;
		c = a;
		d = callocobject();
		e = callocobject();
		while (c != NULL)
			{
			erg += t_ELMSYM_SCHUR(S_S_S(c),e);
			erg += mult_scalar_schur(S_S_K(c),e,d);
			erg += add_apply(d,b);
			c = S_S_N(c);
			}
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		return erg;
		}
	else	{
		erg += WTO("t_ELMSYM_SCHUR",a);
		}
	ENDR("t_ELMSYM_SCHUR");
}

INT t_SCHUR_HOMSYM(a,b) OP a,b;
/* schurpolyomial with det */ 
/* AK 301092 */
{
	INT i,j;
	INT erg = OK;
	OP d,h,c;
	if (check_equal_2(a,b,t_SCHUR_HOMSYM,&erg) == EQUAL)
                return erg;
if(S_O_K(a) == PARTITION)
{
	d = callocobject();
	h = callocobject();
	c = callocobject();
	erg += m_ilih_m(S_PA_LI(a),S_PA_LI(a),d);
	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,j)+j-i,h);
		if (S_I_I(h) == (INT)0)
			M_I_I(1,S_M_IJ(d,i,j));
		else if (S_I_I(h) < (INT)0)
			M_I_I(0,S_M_IJ(d,i,j));
		else 
		{
		erg += m_i_pa(h,c);
		erg += m_pa_h(c,S_M_IJ(d,i,j));
		}
			}
	erg += det_mat_imm(d,b);
	erg += SYMfreeall(d); 
	erg += SYMfreeall(c); 
	erg += SYMfreeall(h); 
	return erg;
}
else if (S_O_K(a) == SCHUR)
{
	erg += init(HOM_SYM,b);
	if (S_L_S(a) == NULL)
		return erg;
	c = callocobject();
	d = a;
	while (d != NULL)
	{
	erg += t_SCHUR_HOMSYM(S_S_S(d),c);
	erg += mult_apply(S_S_K(d),c);
	erg += add_apply(c,b);
	d = S_S_N(d);
	}
	erg += SYMfreeall(c);
	return erg;
}
else 
	{
	printobjectkind(a);
	return error("t_SCHUR_HOMSYM:wrong input type");
	}
}

INT t_MONOMIAL_HOMSYM(a,b) OP a,b;
/* AK 231192 */
{
	INT erg = OK;
	OP c = callocobject();
	erg += t_MONOMIAL_SCHUR(a,c);
	erg += t_SCHUR_HOMSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_HOMSYM_MONOMIAL(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_HOMSYM_SCHUR(a,c);
	erg += t_SCHUR_MONOMIAL(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_ELMSYM_MONOMIAL(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_ELMSYM_SCHUR(a,c);
	erg += t_SCHUR_MONOMIAL(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_ELMSYM_HOMSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_ELMSYM_SCHUR(a,c);
	erg += t_SCHUR_HOMSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_SCHUR_ELMSYM(a,b) OP a,b;
/* schurpolyomial with det */ 
/* AK 231192 */
{
	INT i,j;
	INT erg = OK;
	OP d,h,c,con;
	if (check_equal_2(a,b,t_SCHUR_ELMSYM,&erg) == EQUAL)
                return erg;
	if(S_O_K(a) == PARTITION)
	{
		con = callocobject();
		d = callocobject();
		h = callocobject();
		c = callocobject();
		conjugate(a,con); a=con;
		erg += m_ilih_m(S_PA_LI(a),S_PA_LI(a),d);
		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,j)+j-i,h);
			if (S_I_I(h) == (INT)0)
				M_I_I(1,S_M_IJ(d,i,j));
			else if (S_I_I(h) < (INT)0)
				M_I_I(0,S_M_IJ(d,i,j));
			else 
			{
			erg += m_i_pa(h,c);
			erg += m_pa_e(c,S_M_IJ(d,i,j));
			}
				}
		erg += det_mat_imm(d,b);
		erg += SYMfreeall(d); 
		erg += SYMfreeall(c); 
		erg += SYMfreeall(h);  erg+= SYMfreeall(a);
		return erg;
	}
	else if (S_O_K(a) == SCHUR)
	{
		erg += init(ELM_SYM,b);
		if (S_L_S(a) == NULL)
			return erg;
		c = callocobject();
		d = a;
		while (d != NULL)
		{
		erg += t_SCHUR_ELMSYM(S_S_S(d),c);
		erg += mult_apply(S_S_K(d),c);
		erg += add_apply(c,b);
		d = S_S_N(d);
		}
		erg += SYMfreeall(c);
		return erg;
	}
	else 
		{
		printobjectkind(a);
		return error("t_SCHUR_ELMSYM:wrong input type");
		}
}


#ifdef CHARTRUE
INT t_POWSYM_SCHUR(a,b) OP a,b;
{
	OP c,d,e;
	INT erg = OK,i;
	if (check_equal_2(a,b,t_POWSYM_SCHUR,&erg) == EQUAL)
                return erg;
	if (S_O_K(a) == PARTITION)
		{
		init(SCHUR,b);
		c = callocobject();
		d = callocobject();
		e = callocobject();
		erg += weight(a,c);
		erg += makevectorofpart(c,d);
		for (i=(INT)0;i<S_V_LI(d);i++)
			{
			erg += charvalue(S_V_I(d,i),a,e,NULL);
			if (nullp(e)) continue;

			erg += b_skn_s(callocobject(),e,NULL,c);
			erg += copy(S_V_I(d,i),S_S_S(c));
			erg += add_apply(c,b);
			e = callocobject();
			}
		erg += SYMfreeall(c);
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		return erg;
		}
	else if (S_O_K(a) == POW_SYM)
	{
		erg += init(SCHUR,b);
		if (S_L_S(a) == NULL)
			return erg;
		c = callocobject();
		d = a;
		while (d != NULL)
		{
		erg += t_POWSYM_SCHUR(S_S_S(d),c);
		erg += mult_apply(S_S_K(d),c);
		erg += add_apply(c,b);
		d = S_S_N(d);
		}
		erg += SYMfreeall(c);
		return erg;
	}
	else 
		{
		printobjectkind(a);
		return error("t_POWSYM_SCHUR:wrong input type");
		}
}


INT t_SCHUR_POWSYM(a,b) OP a,b;
{
	OP c,d,e,f;
	INT erg = OK,i;
	if (check_equal_2(a,b,t_SCHUR_POWSYM,&erg) == EQUAL)
                return erg;
	if (S_O_K(a) == PARTITION)
		{
		init(POW_SYM,b);
		c = callocobject();
		d = callocobject();
		e = callocobject();
		f = callocobject();
		erg += weight(a,c);
		erg += makevectorofpart(c,d);
		for (i=(INT)0;i<S_V_LI(d);i++)
			{
			erg += charvalue(a,S_V_I(d,i),e,NULL);
			if (nullp(e)) continue;

			erg += b_skn_ps(callocobject(),e,NULL,c);
			erg += copy(S_V_I(d,i),S_S_S(c));
			erg += ordcen(S_V_I(d,i),f);
			erg += div3(S_S_K(c),f,S_S_K(c));
			erg += add_apply(c,b);
			e = callocobject();
			}
		erg += SYMfreeall(c);
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		erg += SYMfreeall(f);
		return erg;
		}
	else if (S_O_K(a) == SCHUR)
	{
		erg += init(POW_SYM,b);
		if (S_L_S(a) == NULL)
			return erg;
		c = callocobject();
		d = a;
		while (d != NULL)
		{
		erg += t_SCHUR_POWSYM(S_S_S(d),c);
		erg += mult_apply(S_S_K(d),c);
		erg += add_apply(c,b);
		d = S_S_N(d);
		}
		erg += SYMfreeall(c);
		return erg;
	}
	else 
		{
		printobjectkind(a);
		return error("t_SCHUR_POWSYM:wrong input type");
		}
}


INT t_POWSYM_HOMSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_POWSYM_SCHUR(a,c);
	erg += t_SCHUR_HOMSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_HOMSYM_POWSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_HOMSYM_SCHUR(a,c);
	erg += t_SCHUR_POWSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}


INT t_POWSYM_ELMSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_POWSYM_SCHUR(a,c);
	erg += t_SCHUR_ELMSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_ELMSYM_POWSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_ELMSYM_SCHUR(a,c);
	erg += t_SCHUR_POWSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_POWSYM_MONOMIAL(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_POWSYM_SCHUR(a,c);
	erg += t_SCHUR_MONOMIAL(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT t_MONOMIAL_POWSYM(a,b) OP a,b;
/* AK 231192 */
{
	OP c = callocobject();
	INT erg = OK;
	erg += t_MONOMIAL_SCHUR(a,c);
	erg += t_SCHUR_POWSYM(c,b);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* CHARTRUE */
#endif /* SCHURTRUE */
INT cast_apply_schur(a) OP a;
{
#ifdef SCHURTRUE
	INT erg = OK;
	switch (S_O_K(a)) {
		case INTEGER: /* AK 280494 */
			erg += m_skn_s(NULL,a,NULL,a);
			C_S_S(a,callocobject());
			erg += m_i_pa(cons_null, S_S_S(a));
			break;
		case PARTITION:
			erg += m_pa_s(a,a);
			break;
		default:
			erg += WTO("cast_apply_schur",a);
			break;
		}
	ENDR("cast_apply_schur");
#else
	return error("cast_apply_schur:SCHUR not available");
#endif /* SCHURTRUE */
}

INT scalarproduct_schur(a,b,c) OP a,b,c;
{
#ifdef SCHURTRUE
        OP za,zb;
        OP d;
        INT res;
	INT erg = OK;
        d = callocobject();
        za = a;
        zb = b;
        erg += m_i_i((INT)0,c);
        do {
                if (za == NULL) goto ende;
                if (zb == NULL) goto ende;
                res = comp(S_S_S(za),S_S_S(zb));
                if (res == (INT)0)
                        {
                        erg += mult(S_S_K(za),S_S_K(zb),d);
                        erg += add_apply(d,c);
                        za = S_S_N(za);
                        zb = S_S_N(zb);
                        }
                else if (res < (INT)0)
                        {
                        za = S_S_N(za);
                        }
                else    {
                        zb = S_S_N(zb);
                        }
        } while(1);
ende:
        erg += SYMfreeall(d);
        ENDR("scalarproduct_schur");
#else
        return error("scalarproduct_schur:SCHUR not available");
#endif /* SCHURTRUE */
}
#ifdef SCHURTRUE
static co_1611(a,b) OP a,b;
/* transform polynom to vector of monoms */
{
	OP z;
	INT i=0,j;
	z = a;
	while (z != NULL)
		{
		i += S_PO_KI(z);
		z = S_PO_N(z);
		}

	m_il_v(i,b);
	z = a;
	for (i=0;i<S_V_LI(b);)
		{
		if (z == NULL) error("");
		for (j=0;j<S_PO_KI(z);j++)
			{
			m_skn_po(S_PO_S(z),cons_eins,NULL,S_V_I(b,i));
			i++;
			}
        z = S_PO_N(z);
        }
	return OK;
}

INT plet_schur_schur_pol(parta,partb, len, res)
        OP parta,partb, len, res;
/* plethysm of schur polynomials S_b(S_a(A_len)) */
/* res is polynom */
{
        OP d,c ,e;
        INT erg = OK;
        c = callocobject();
        e = callocobject();
        erg += compute_schur_with_alphabet(parta,len,c);
        erg += co_1611(c,e);
        erg += compute_schur_with_alphabet(partb,S_V_L(e),c);
        erg += eval_polynom(c,e,res);
        erg += SYMfreeall(c);
        erg += SYMfreeall(e);
        ENDR("plet_schur_schur_pol");
}
             


static OP ll=NULL;
static INT co111(a) OP a;
{
        return le(S_PA_L(S_MO_S(a)),ll);
}
 
INT put_length_limit_schur(i,a) OP a; INT i;
/* i ist the max length for part */
{
	INT erg = OK;
	CTO(SCHUR,"put_length_limit_schur",a);
	ll = callocobject();
	erg += m_i_i(i,ll);
	erg += filter_apply_list(a,co111);
	erg += SYMfreeall(ll);
	ll = NULL;
	ENDR("put_length_limit_schur");
}


static INT m_int_Qelm(a,b) INT a; OP b;
{
	INT erg = OK;
	OP c = callocobject();
	OP d = callocobject();
	OP e;
	if (a == (INT)0)
		{
		m_i_i(1,b);	
		goto ee;
		}
	m_i_i(a,c);
	init(MONOMIAL,b);
	first_partition(c,d);
	do {
	e = callocobject();
	erg += m_skn_mon(d,callocobject(),NULL,e);
	hoch(cons_zwei,S_PA_L(d),S_S_K(e));
	insert(e,b,NULL,NULL);
	} while (next(d,d));
ee:
	SYMfreeall(c);
	SYMfreeall(d);
	ENDR("m_int_Qelm");
}
static INT m_int_int_Qelm(a,b,d) INT a,b; OP d;
{
	OP c = callocobject();
	INT erg = OK;
	if (a>b) error("::");
	erg += b_ks_pa(VECTOR,callocobject(),c);
	erg += m_il_v(2L,S_PA_S(c));
	erg += m_i_i(a,S_PA_I(c,0));
	erg += m_i_i(b,S_PA_I(c,1));
	erg += m_part_Qschur(c,d);
	erg += SYMfreeall(c);
	ENDR("m_int_int_qelm");
		
}

INT m_part_Qschur(a,b) OP a,b;
/* AK 291295 */
/* computes Q schur polynomial as monomial sym */
{
	INT i,j;
	OP c,d,e;
	INT erg = OK;

	CTO(PARTITION,"m_part_Qschur",a);
	if (S_PA_LI(a) == 1) 
		{
		erg += m_int_Qelm(S_PA_II(a,0),b);
		}
	else if (S_PA_LI(a) == 2)
		{
		c = callocobject();
		erg += m_int_Qelm(S_PA_II(a,0),c);
		d = callocobject();
		erg += m_int_Qelm(S_PA_II(a,1),d);
		erg += mult(c,d,b);
		e = callocobject();
		for (i=1;i<=S_PA_II(a,0);i++)
			{
			erg += m_int_Qelm(S_PA_II(a,0)-i,c);
			erg += m_int_Qelm(S_PA_II(a,1)+i,d);
			erg += mult(c,d,e);
			erg += mult_apply(cons_zwei,e);
			if (i%2 == 1)
				erg += mult_apply(cons_negeins,e);
			erg += add_apply(e,b);
			}
		erg += SYMfreeall(c);
		erg += SYMfreeall(d);
		erg += SYMfreeall(e);
		}
	else if  (S_PA_LI(a) %2 == 0)
		{
		c = callocobject();
		erg += m_ilih_m(S_PA_LI(a), S_PA_LI(a),c);
		for (i=0;i<S_M_HI(c);i++)
			for (j=i+1;j<S_M_LI(c);j++)
				{
				m_int_int_Qelm(S_PA_II(a,S_PA_LI(a)-1-j),
					S_PA_II(a,S_PA_LI(a)-1-i),S_M_IJ(c,i,j));
				}
		pfaffian_matrix(c,b);
		erg += SYMfreeall(c);
		}
	else	{
		d = callocobject();
		b_ks_pa(VECTOR,callocobject(),d);
		m_il_nv(S_PA_LI(a)+1,S_PA_S(d));
		for (i=0;i<S_PA_LI(a);i++)
			M_I_I(S_PA_II(a,i),S_PA_I(d,i+1));
		
		c = callocobject();
		erg += m_ilih_m(S_PA_LI(d), S_PA_LI(d),c);
		for (i=0;i<S_M_HI(c);i++)
			for (j=i+1;j<S_M_LI(c);j++)
				{
				m_int_int_Qelm(S_PA_II(d,S_PA_LI(d)-1-j),
					S_PA_II(d,S_PA_LI(d)-1-i),S_M_IJ(c,i,j));
				}
		pfaffian_matrix(c,b);
		erg += SYMfreeall(c);
		SYMfreeall(d);
		}
	ENDR("m_part_Qschur");
}

#endif /* SCHURTRUE */
#ifdef SCHURTRUE
#endif /* SCHURTRUE */


