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

static INT rh_kostka();
static INT rh_insert();
static INT rh_delete();
static INT rh_ausgabemat();
static INT rh_kostka_kostka();
static INT lookupinschurspeicher();
static INT kostka_tab_partition();
static INT kostka_tab_skewpartition();
static INT neu_n_kostka();
static INT nspeicherkostka();

#ifdef RH_MAX
#undef RH_MAX
#endif 

#define	RH_MAX	100




#ifdef KOSTKATRUE

INT kostka_number(inh,umriss,res) OP inh,umriss,res;
/* AK 020890 V1.1 */ /* AK 210891 V1.3 */
{
	OP d;
	INT i;
	INT erg = OK;

	if (S_O_K(inh) == PARTITION) /* AK 100992 */
		d = S_PA_S(inh);
	else if (S_O_K(inh) == VECTOR)
		d = inh;
	else if (S_O_K(inh) == INTVECTOR)
		d = inh;
	else
		{
		WTO(inh,"kostka_number:inhalt");
		goto endr_ende;
		}
	if (not EMPTYP(res))
		erg += freeself(res);
	for (i=(INT)0;i<S_V_LI(d);i++)
		if (S_O_K(S_V_I(d,i)) != INTEGER)
			{
			erg += error("kostka_number: wrong content type");
			goto endr_ende;
			}

	if (S_O_K(umriss) == PARTITION)
		if (S_PA_LI(umriss)==0L||S_V_LI(d)==0L){ 
/*CC 09-11-04*/
		return error("kostka_number: length of shape or content null");
		}
		else
			erg += kostka_number_partition(d,umriss,res);
	else if (S_O_K(umriss) == SKEWPARTITION)
	{
/*CC 09/11/04*/
		if (S_PA_LI(S_SPA_G(umriss))==0L||S_V_LI(d)==0L)
		return error("kostka_number: length of big shape or content null");

		erg += kostka_number_skewpartition(d,umriss,res);
	}
	else 
		WTO(inh,"kostka_number:umriss");

	ENDR("kostka_number");
}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT kostka_number_partition(inha,umriss,erg) OP inha,umriss,erg;
/* Ralf Hager */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
{
	INT	i;
	INT	zaehler = (INT)0;

	INT	len,n;
	OP d = callocobject();
	INT *um,*hilf,*ziel,*inh;

	um = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	hilf = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	ziel = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	inh = (INT *)SYM_malloc(RH_MAX*sizeof(INT));

	conjugate(umriss,d);
	for (i=(INT)0;i<RH_MAX;i++) { 
		hilf[i]=(INT)0; 
		um[i]=(INT)0; 
		ziel[i]=(INT)0; 
		inh[i]=(INT)0; 
		}
	n= S_PA_LI(d);
	for(i=1L;i<=n;++i) { um[i]=S_PA_II(d,n-i); hilf[i] = um[i]; }
	um[0] = -1L;
	for(i=(INT)0;i<n;++i) {um[i+1]=um[1]+i; ziel[i+1]=um[i+1]-hilf[i+1]; }
	len=S_V_LI(inha); 
	for(i=1L;i<=len;++i) inh[i]=S_V_II(inha,len-i);
	SYMfreeall(d);
	SYM_free(hilf);
		
	rh_kostka_kostka(um,ziel,inh,(INT)0,(INT)0,inh[1],1L,len,n,&zaehler);
	M_I_I(zaehler,erg);
	SYM_free(um);
	SYM_free(inh);
	SYM_free(ziel);
	return(OK);
}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
static INT rh_kostka_kostka(um,ziel,inh,k,i,zahl,st,len,n,zaehler)
	INT	um[RH_MAX];
	INT	ziel[RH_MAX];
	INT	inh[RH_MAX];
	INT	k,i,zahl,st,len,n,*zaehler;
/* Ralf Hager */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
{
	INT	l;

	if(i==zahl)	
		{
	     if(st==len) ++(*zaehler);
	     else rh_kostka_kostka(um,ziel,inh,(INT)0,(INT)0,inh[st+1],st+1L,len,n,zaehler);
		}
	else
		{
		for(l=k+1L;l<=n;++l)
			if(((um[l]-1L) > um[l-1])&&(um[l] > ziel[l]))
			 {
			 um[l]--;
			 rh_kostka_kostka(um,ziel,inh,l,i+1L,zahl,st,len,n,zaehler);
			 um[l]++;
			 }
		}
	return(OK);
}
#endif /* KOSTKATRUE */


#ifdef KOSTKATRUE
INT kostka_tafel(a,b) OP a,b;
/* AK 220488 */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */ /* AK 190691 V1.2 */
/* AK 210891 V1.3 */
	{
	return neu_n_kostka(a,b);
	}
#endif /* KOSTKATRUE */


#ifdef KOSTKATRUE
INT make_n_transpositionmatrix(dim,mat) OP dim,mat;
/* 300388 berechnet die matrix J [MD p.55]
J_PQ = 1 <==> conjugierte Partition von P ist Q, null sonst */
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT i;
	OP conpart=callocobject(); 
	OP vector=callocobject(); 

	init_kostka(dim,mat,vector);
	for (i=(INT)0;i<s_m_hi(mat);i++)
		{ 
		conjugate(S_V_I(vector,i),conpart);
		M_I_I(1L,S_M_IJ(mat,i,indexofpart(conpart))); 
		};
	SYMfreeall(conpart);
	SYMfreeall(vector); 
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT tex_kostka(koma,vector) OP koma,vector;
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* koma ist die matrix, vector der vector der partitionen */
/* AK 070291 V1.2 prints to texout */
/* AK 210891 V1.3 */
	{
	INT i,j;
	fprintf(texout,"$ \\matrix {  ");
	for (i=(INT)0;i<S_V_LI(vector);i++)
		{ 
		fprintf(texout," & "); 
		fprint(texout,S_V_I(vector,i)); 
		texposition = (INT)0; 
		};
	fprintf(texout," \\cr \n");
	for (i=(INT)0;i<S_V_LI(vector);i++)
		{
		fprint(texout,S_V_I(vector,i)) ; 
		texposition = (INT)0;
		for (j=(INT)0;j<=i;j++)
			{ fprintf (texout," & ");
			fprintf(texout," %d ",S_M_IJI(koma,i,j)); };
		for (j=i+1L;j<S_V_LI(vector);j++) 
			 fprintf(texout," & ");
		fprintf(texout," \\cr \n");
		};
	fprintf(texout," } $"); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT scan_kostka(a) OP a;
/* AK 280388 */ /* AK 170789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP i = callocobject(); 
	INT erg = OK;
	printeingabe("Gewicht der Kostkamatrix");
	erg += scan(INTEGER,i); 
	erg += kostka_tafel(i,a); 
	erg += SYMfreeall(i); 
	ENDR("scan_kostka");
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
static INT lookupinschurspeicher(part,ergebnis,c) OP part,ergebnis,c;
/* sucht in speicher die entsprechenden eintraege 
falls nicht vorhanden werden sie berechnet
140687 */
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT i;
	OP w,zeigerw,zeigeri;


	if (not EMPTYP(ergebnis)) freeself(ergebnis);
	w = callocobject();
	if (S_PA_LI(part) == 1L)   /* falls ein-elementige partition [n] */
		{
		copy_partition(part,w);
		b_pa_s(w,ergebnis); /* dann die schurfunktion {n} */
		return(OK);	  /* ende */
		};

	/* sortiert nach gewicht und index der partition */
	
	weight_partition(part,w);	  /* gewicht w ist erster index */
	i = indexofpart(part);	  /* index i der part. ist 2. index */

	zeigerw = S_V_I(c,S_I_I(w)-1L); 
/* zeiger auf zeile in der speicher- matrix mit partitionen vom gewicht w*/

	if (EMPTYP(zeigerw))	 /* wenn in zeile w noch keine eintraege */
		{
			 /* laenge der zeile w ist gerade anzahl
			der part vom gewicht w */
		m_il_v(numberofpart_i(w),zeigerw);   
			/* schaffe speicherplatz fuer zeile w */
		};

	zeigeri = S_V_I(zeigerw,i);	/* zeiger auf spaltenindex */

	freeself(w);
	if (EMPTYP(zeigeri))
		{
		OP einspart = callocobject();
		OP einspartschur = callocobject();
		OP kurzergebnis = callocobject();
		m_i_pa(S_PA_I(part,S_PA_LI(part)-1L),einspart);
		b_pa_s(einspart,einspartschur);
				/* einspartschur ist schurfunktion
				aus dem letzten element von part */

		copy_partition(part,w); dec(w);
				/* w ist part ohne letztes element*/
		lookupinschurspeicher (w,kurzergebnis,c);
		SYMfreeall(w);
				/* w war nur zum suchen noetig */


		mult_schur_schur(kurzergebnis,einspartschur,ergebnis);
		SYMfreeall(kurzergebnis); SYMfreeall(einspartschur);
		copy(ergebnis,zeigeri);	/* ergebnis speichern*/
		return(OK);
		};

	/* falls ergebnis im speicher */
	SYMfreeall(w);
	copy(zeigeri,ergebnis);
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
static INT neu_n_kostka(n,komatrix) OP n,komatrix;
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP speicher = callocobject();
	/* hier werden die bereits berechneten schurfunktionen
	gespeichert */

	m_il_v((INT)150,speicher);
	/* d.h maximal bis dim 150 */
	/* initialisieren der Matrix */

	nspeicherkostka(n,speicher,komatrix);
	SYMfreeall(speicher); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT allkostka(n) OP n;
/* AK 190687 gibt alle kostkamatrizen bis n aus */
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP speicher = callocobject();
	/* hier werden die bereits berechneten schurfunktionen
	gespeichert */
	OP lauf = callocobject();
	/* lauf variable bis n */
	/* initialisieren des speichers */
	OP komatrix = callocobject() ;
	
	m_il_v(150L,speicher);
	/* d.h maximal bis dim 150 */
	/* initialisieren der Matrix */
	

	for (M_I_I(1L,lauf);le(lauf,n);inc(lauf))
		{
		OP var = callocobject();
		copy(lauf,var);
		printf("kostkamatrix fuer ");
		println(lauf);
		nspeicherkostka(var,speicher,komatrix);
		println(komatrix);
		freeself(komatrix);
		}

	SYMfreeall(lauf); SYMfreeall(komatrix); SYMfreeall(speicher); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
static INT nspeicherkostka(n,sp,komatrix) OP n; OP komatrix; OP sp;
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	INT i,j,pi,pj, k,partadr;
	OP zeiger;
	OP schur = callocobject();
	OP vector = callocobject();
	OP prepart = callocobject();

	init_kostka(n,komatrix,vector);
	/* initialisieren der 1. Zeile */
	M_I_I(1L,S_M_IJ(komatrix,(INT)0,(INT)0));
	/* globale schleife ueber alle partitionen */

	for (i=1L;i<S_V_LI(vector);i++)
		{
		/* suche die benachbarte partition bzgl
		der dominanzordnung */
		prepartdom(S_V_I(vector,i),&pi,&pj,prepart);
		j=(i-1L);
		while (NEQ(prepart,S_V_I(vector,j))) j--;
		/* j ist jetzt die adresse von prepart in partvec */
		/* pi, pj die zeilennummer in denen getauscht wurde um
		den dominanten nachbarn zu erhalten
		*/
		make_neu_partij_schur(S_V_I(vector,i),pi,pj,schur,sp);
		/* die zeile j der matrix wird in die zeile i kopiert */
		for (k=(INT)0;k<=j;k++)
			M_I_I(S_M_IJI(komatrix,j,k),S_M_IJ(komatrix,i,k));
		/* jetzt werden die beitraege von schur addiert */
		zeiger = schur;
		while (zeiger != NULL)
			{
			partadr=(INT)0;
			while(NEQ(S_S_S(zeiger),S_V_I(vector,partadr)))
				partadr++;
			/* partadr ist index des monoms von zeiger */

			add(S_S_K(zeiger),S_M_IJ(komatrix,i,partadr),
				S_M_IJ(komatrix,i,partadr) );
			zeiger = S_S_N(zeiger);
			};
		freeself(schur); 
		freeself(prepart);
		};
	SYMfreeall(schur); SYMfreeall(prepart); SYMfreeall(vector); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT removepartij(part,i,j,neupart) OP part,neupart; INT i,j;
/* AK 260587 */
/* entfernt aus partition part die Teile i,j
und ergibt so die neue partition neupart */
/* bsp: removepartij(1224568, 2,3, neupart ist dann 12568 */
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT l,nl;
	if (not EMPTYP(neupart)) freeself(neupart);
	if (S_PA_LI(part) <2L) 
		{ error("partition der laenge < 2 in removepartij");
		return(ERROR); }
	else if (S_PA_LI(part) == 2L) return(OK);


	b_ks_pa(VECTOR,callocobject(),neupart);
	m_il_v(S_PA_LI(part)-2L,S_PA_S(neupart));
	nl =(INT)0; /* adr. in neupart */

	for (l=(INT)0;l<S_PA_LI(part);l++)
		if ((l!=i)&&(l!=j))
			{
			M_I_I(S_PA_II(part,l),S_PA_I(neupart,nl));
			nl++;
			};
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT make_ij_part(part,i,j,neupart) INT i,j; OP part,neupart;
/* macht zweizeilige Partition */
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	if (not EMPTYP(neupart)) freeself(neupart);
	if (S_PA_LI(part) <2L) 
		{
		return error("partition der laenge < 2 in removepartij");
		}
	b_ks_pa(VECTOR,callocobject(),neupart);
	m_il_v(2L,S_PA_S(neupart));
	M_I_I(S_PA_II(part,i),S_PA_I(neupart,(INT)0));
	M_I_I(S_PA_II(part,j),S_PA_I(neupart,1L));
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT make_partij_perm(part,i,j,perm) OP part,perm; INT i,j;
/* AK 190587 */
/* es gilt i<j
partition ist eine aufsteigende zahlenfolge
prozedur bildet aus einer partition p = [p1,p2,..,pn]
eine permutation, die den index zum schubert-
polynom fuer
{pi,pj} x {p1}x..x{pi-1}x{pi+1}x..x{pj-1}x{pj+1}x..x{pn}
bildet */
/* ok am 190587 */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP permlength = callocobject();
	OP zw = callocobject();
	OP code = callocobject();
	INT l,
	codeadresse ;/* stelle zum einfuegen im code */

	/* 
	als erstes die laenge der permutation berechnen
	*/

	if (not EMPTYP(perm)) freeself(perm);
	weight_partition(part,permlength);
	sub(permlength,S_PA_I(part,i),permlength);
	length(part,zw);
	add(zw,permlength,permlength);
	INC_INTEGER(permlength);

	/* den lehmercode aufbauen */
	m_il_v(S_I_I(permlength),code); SYMfreeall(permlength);
	for (l=(INT)0;l<S_I_I(permlength);l++) M_I_I((INT)0,S_V_I(code,l));
	M_I_I(S_PA_II(part,i),S_V_I(code,1L));
	M_I_I(S_PA_II(part,j),S_V_I(code,2L));
	codeadresse = 2L + S_PA_II(part,j) + 1L;
	for (l=(INT)0;l<S_PA_LI(part);l++)
		{
		if ((l!=i) && (l!=j)) 
			{
			M_I_I(S_PA_II(part,l),S_V_I(code,codeadresse));
			codeadresse += S_PA_II(part,l);
			codeadresse++;
			};
		}
	/* den code umwandeln in permutation */
	
	lehmercode_vector(code,perm);
	/* alles unnoetige wieder freigeben */

	SYMfreeall(code); SYMfreeall(zw);
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT make_neu_partij_schur(part,i,j,schur,sp) 
		OP part,schur, sp;INT i,j;
/* AK 140687 */ /* mit lookup */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP a = callocobject();
	OP b = callocobject();
	OP zweizeilenpart = callocobject();
	OP kleinerpart = callocobject();

	if (not EMPTYP(schur)) freeself(schur);
	removepartij(part,i,j,kleinerpart);
	make_ij_part(part,i,j,zweizeilenpart);
	b_pa_s(zweizeilenpart,a);/*zweizeilenpart muss nicht freigegeben
				werden */
	if (EMPTYP(kleinerpart))	 copy(a,schur);
	else	{ lookupinschurspeicher(kleinerpart,b,sp);
		mult_schur_schur(a,b,schur); };

	SYMfreeall(a);SYMfreeall(b); SYMfreeall(kleinerpart); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT make_partij_schur(part,i,j,schur) OP part,schur; INT i,j;
/* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	OP perm = callocobject();
	make_partij_perm(part,i,j,perm);
	if (not EMPTYP(schur)) freeself(schur);
	newtrans(perm,schur); SYMfreeall(perm); return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT prepartdom(part,i,j,prepart) OP part,prepart; INT *i,*j;
/* AK 190587 */
/* berechnet einen groesseren nachbarn prepart 
der Partition part bezueglich der
dominanzordnung
dazu wird der satz verwandt, dass ein dominanter nachbar
sich nur durch ein verschobenes kaestchen im young-diagramm
unterscheidet
i ist die zeile in part wo ein kaestchen weggenommen wird
j ist die zeile in part wo es angefuegt wird */
/* ok 200587 */ /* AK 200789 V1.0 */ /* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT l;
	if (not EMPTYP(prepart)) freeself(prepart);
	*i = (INT)0;
	/* falls die partition part mit 1 beginnt */
	if (einsp(S_PA_I(part,(INT)0)))
		{
		b_ks_pa(VECTOR,callocobject(),prepart);
		m_il_v(S_PA_LI(part) - 1L,S_PA_S(prepart));

		/* prepart ist dann um eins kuerzer */
		/* kopiere part ohne den ersten teil*/
		for (l=1L;l<S_PA_LI(part);l++)
			M_I_I(S_PA_II(part,l),S_PA_I(prepart,(l-1L)));
		/* suche die stelle zum anfuegen des kaestchenens */
		for (l=1L;l<S_PA_LI(prepart);l++)
			if (S_PA_II(prepart,l) > S_PA_II(prepart,(l-1L)))
				{
				INC_INTEGER(S_PA_I(prepart,(l-1L)));
				*j = l; goto prepartende;
				};
		/* der Sonderfall falls in der letzten Zeile ein
		kaestchen angefuegt wird */
		INC_INTEGER(S_PA_I(prepart,(l-1L)));
		*j = l; goto prepartende;
		}
	else 	{
		/* part beginnt mit > 1 */
		copy_partition(part,prepart);
		DEC_INTEGER(S_PA_I(prepart,(INT)0));
		for (l=2L;l<S_PA_LI(prepart);l++)
			if (S_PA_II(prepart,l) > S_PA_II(prepart,(l-1L)))
				{
				INC_INTEGER(S_PA_I(prepart,(l-1L)));
				*j = l-1L; goto prepartende;
				};
		INC_INTEGER(S_PA_I(prepart,(l-1L)));
		*j = l-1L; goto prepartende;
		};
	prepartende:
	return(OK);
	}
#endif /* KOSTKATRUE */

#ifdef KOSTKATRUE
INT init_kostka(n,koma,vector) OP koma,n,vector;
/* AK 250587 */ /* AK 200789 V1.0 */
/* koma wird eine Matrix gross genug, vector ein vector der partitionen */
/* AK 181289 V1.1 */
/* AK 210891 V1.3 */
	{
	INT i,j,l;

	if (not EMPTYP(koma)) freeself(koma);
	if (not EMPTYP(vector)) freeself(vector);
	makevectorofpart(n,vector);
	l = S_V_LI(vector);
	m_ilih_m(l,l,koma);  /* AK 030189 */
	for (i=(INT)0;i<l;i++) for (j=(INT)0;j<l;j++) M_I_I((INT)0,S_M_IJ(koma,i,j));
	return(OK);
	}
#endif /* KOSTKATRUE */


#ifdef KOSTKATRUE
INT test_kostka() 
/* AK 181289 V1.1 */ /* AK 210891 V1.3 */
	{
	OP a = callocobject();
	OP b = callocobject();
	OP c = callocobject();

	printf("test_kostka:scan(a)");
	scan(KOSTKA,a);println(a);
	printf("test_kostka:add(a,a,b)");
	add(a,a,b);
	println(b);
	printf("test_kostka:mult(a,b,b)"); mult(a,b,b); println(b);
#ifdef BRUCHTRUE
	printf("test_kostka:invers(a,b)");
	invers(b,a);
	println(a);
#endif /* BRUCHTRUE */
	printf("test_kostka:make_n_transpositionmatrix(a,b)"); 
	scan(INTEGER,a);
	make_n_transpositionmatrix(a,b); println(b);
	printf("test_kostka:scan(PARTITION,a)(inh)"); scan(PARTITION,a);
	printf("test_kostka:scan(PARTITION,b)(umriss)"); scan(PARTITION,b);
	printf("test_kostka:kostka_number(a,b,c)"); 
	kostka_number(a,b,c);println(c);

	SYMfreeall(a);SYMfreeall(b);
	return(OK);
	}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT kostka_tab(a,b,c) OP a,b,c;
/* AK 131190 V1.1 */ /* AK 160791 V1.3 */
/* return: LIST of TABLEAUX or SKEWTABLEAUX */
/* a is shape, b is content */
{
	OP d;
	OP aa,bb;
	INT i,erg = OK;

	if (S_O_K(b) == PARTITION) /* AK 100992 */
		d = S_PA_S(b);
	else if (S_O_K(b) == VECTOR)
		d = b;
	else
		{
		WTO(b,"kostka_tab");
		goto endr_ende;
		}

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

	for (i=(INT)0;i<S_V_LI(d);i++)
		if (S_O_K(S_V_I(d,i)) != INTEGER)
			{
			erg += error("kostka_tab: wrong content type");
			goto endr_ende;
			}

	switch (S_O_K(a)) {
		case PARTITION:
			if (S_PA_LI(a)==0L||S_V_LI(d)==0L) 
/*CC 12-11-04*/
				return error("kostka_tab: length of shape or content null");
			aa=callocobject();
			bb=callocobject();
			sum(d,aa); weight(a,bb);
			if(S_I_I(aa)!=S_I_I(bb)){
				init(SYMLIST,c);
				SYMfreeall(aa); SYMfreeall(bb);
				return OK;
			}	
			SYMfreeall(aa);SYMfreeall(bb);
		       	return kostka_tab_partition(a,d,c);
		case SKEWPARTITION:
			if (S_PA_LI(S_SPA_G(a))==0L||S_V_LI(d)==0L) 
/*CC 09-11-04*/
			return error("kostka_tab: length of shape or content null");
			if(S_PA_LI(S_SPA_K(a))==0L)
				return kostka_tab_partition(S_SPA_G(a),d,c);
			aa=callocobject();
			bb=callocobject();
			sum(d,aa); weight(a,bb);
			if(S_I_I(aa)!=S_I_I(bb)){
				init(SYMLIST,c);
				SYMfreeall(aa); SYMfreeall(bb);
				return OK;
			}	
			SYMfreeall(aa);SYMfreeall(bb);
		       	return kostka_tab_skewpartition(a,d,c);
		default: printobjectkind(a);
			return error("kostka_tab: wrong shape");
	ENDR("kostka_tab");
	}
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
typedef INT KO_INTARRAY[RH_MAX];

static INT kostka_tab_partition(a,b,c) OP a,b,c;
/* Ralf Hager 1989 */
/* a ist partition fuer umriss */ /* b ist vector fuer inhalt */
/* c wird liste mit allen tableau */ /* AK 271289 V1.1 */
/* AK 210891 V1.3 */
{
	INT	i,j;

	INT	*um,*hilf,*ziel,len,n;
	INT	(* tab)[RH_MAX];
	INT	x,*inh,*hilf_zwei,k;
	INT	counter = (INT)0;
	tab = (KO_INTARRAY *) SYM_calloc(RH_MAX*RH_MAX,sizeof(INT));
	ziel = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	hilf = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	hilf_zwei = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	inh = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	um = (INT *) SYM_malloc(RH_MAX * sizeof(INT));

	init(BINTREE,c); /* AK 170392 */

	for (i=1L;i <=S_PA_LI(a); i++)
		hilf_zwei[i] = S_PA_II(a,S_PA_LI(a)-i);
	x = S_PA_LI(a);
	n = hilf_zwei[1];
	um[1] =  k = x;
	j = 2L;
	while(k >= 1L)
		{
		counter = (INT)0;
		for(i=j;i<=hilf_zwei[k];++i) { counter++; um[i] = x; }
		k--;
		x=k;
		j+= counter;
		}
	for(i=1L;i<=n;++i) hilf[i] = um[i];
	um[0] = -1L;
	for(i=(INT)0;i<n;++i)
		{ um[i+1] = um[1]+i; ziel[i+1] = um[i+1] - hilf[i+1]; }
	len = S_V_LI(b);
	for (i=1L;i <= S_V_LI(b); i++) 
		inh[i] = S_V_II(b,i-1L);

	SYM_free(hilf_zwei);
	SYM_free(hilf);
	rh_kostka(tab,um,ziel,inh,(INT)0,(INT)0,inh[1],1L,len,n,um[1],c,a);
	SYM_free(um);
	SYM_free(ziel);
	SYM_free(inh);
	SYM_free(tab);
	t_BINTREE_LIST(c,c); /* AK 170392 */
	return(OK);
	
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

static INT rh_kostka(tab,um,ziel,inh,k,i,zahl,st,len,n,deg,c,d)
	INT	tab[RH_MAX][RH_MAX];
	INT	um[RH_MAX];
	INT	ziel[RH_MAX];
	INT	inh[RH_MAX];
	INT	k,i,zahl,st,len,n,deg;
	OP c,d;
{
	INT	l;

	if(i==zahl)	
		{
		if(st==len) 
			rh_ausgabemat(tab,deg,n,c,d); 
		else
		rh_kostka(tab,um,ziel,inh,(INT)0,(INT)0,
			inh[st+1],st+1L,len,n,deg,c,d);
		}
	else 
		{
		for(l=k+1L;l<=n;++l)
			{
			if(((um[l]-1L) > um[l-1])&&(um[l] > ziel[l]))
				{
					um[l]--;
					rh_insert(tab[l],st,len);
					rh_kostka(tab,um,ziel,inh,l,
						i+1L,zahl,st,len,n,deg,c,d);
					rh_delete(tab[l],st,len);
					um[l]++;
				}
			}
		}
	return(OK);
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

static INT rh_ausgabemat(tab,n,laenge,c,d)
		INT tab[RH_MAX][RH_MAX],n,laenge; OP c,d;
/* c ist liste, d ist umriss */
/* Ralf Hager 1989 */ /* AK 281289 V1.1 */ /* AK 210891 V1.3 */
{
	INT	i;
	INT	j;
	INT erg = OK;
	OP e = callocobject();
	OP f = callocobject();

	erg += copy(d,e);
	erg += m_u_t(e,f);
	for(i=1L;i<=n;++i)
		for(j=1L;j<=laenge;++j)
			{ 
			if (tab[j][i] > (INT)0) 
				M_I_I(tab[j][i],S_T_IJ(f,i-1L,j-1L));
			}
	
	insert(f,c,NULL,NULL);
	erg += SYMfreeall(e); /* AK 130392 */
	return erg;
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
static INT rh_insert(v,z,len) INT	v[RH_MAX]; INT z,len;
{
	INT	i;

	for(i=1L;i<=len;++i)
		if(v[i]==(INT)0) { v[i]=z; break; }
	return(OK);
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
static INT rh_delete(v,z,len) INT	v[RH_MAX]; INT z,len;
{
	INT	i;

	for(i=len;i>=1L;--i)
		if(v[i]>(INT)0) { v[i]=(INT)0; break; }
	return(OK);
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT kostka_character(a,b) OP a,b;
/* AK 020290 V1.1 */
/* AK 210891 V1.3 */
{
	OP c = callocobject();
	m_part_kostkaperm(a,c);
	newtrans(c,b);
	SYMfreeall(c);
	return(OK);
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

INT m_part_kostkaperm(a,b) OP a,b; 
/* AK 020290 V1.1 */
/* AK 210891 V1.3 */
{
	INT i,j;
	OP z;
	OP c = callocobject();
	OP d = callocobject();
	weight(a,c);
	m_il_v(S_I_I(c) + S_PA_LI(a),d);
	z = S_V_S(d);
	for (i=(INT)0;i<S_PA_LI(a);i++)
		{ M_I_I(S_PA_II(a,i), z++); 
	  for (j=0;j<S_PA_II(a,i);j++) M_I_I((INT)0,z++);
		}
	lehmercode(d,b);
	SYMfreeall(c);SYMfreeall(d);
	return(OK);
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT moebius_tafel(n,m) OP n,m;
/* eins an den eintraegn der kostkatafel */
/* AK 300790 V1.1 */
/* AK 210891 V1.3 */

	{
	INT i , j;
	OP c = callocobject();
	kostka_tafel(n,c);
	for (i=0;i<S_M_HI(c); i++) 
	for (j=0;j<S_M_HI(c); j++) 
		if (not nullp(S_M_IJ(c,i,j))) {
			if (S_O_K(S_M_IJ(c,i,j)) != INTEGER) 
				freeself(S_M_IJ(c,i,j));
			m_i_i(1L,S_M_IJ(c,i,j)); }
	invers(c,m);
	SYMfreeall(c);
	return(OK);
	}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT stirling_second_number_kostka(n,k,result) OP n,k,result;
/* computes stirling number of the second kind,
using kostkanumbers */
/* AK 300790 V1.1 */
/* AK 210891 V1.3 */
{
	OP lp = callocobject();
	OP pv = callocobject();
	OP h1 = callocobject();
	OP h2 = callocobject();
	OP h3 = callocobject();
	OP h4 = callocobject();
	INT i,j;
	m_i_i((INT)0,result); /* freese result first */
	makevectorofpart(n,pv);
	for (i=0;i<S_V_LI(pv);i++)
	{
	if (S_PA_LI(S_V_I(pv,i)) == S_I_I(k))
		{
		m_i_i((INT)0,h4);
		for (j=0;j<S_V_LI(pv);j++)
			{
			kostka_number(S_V_I(pv,i),S_V_I(pv,j),h1);
			kostka_number(S_V_I(pv,S_V_LI(pv)-1L),S_V_I(pv,j),h2);
			mult(h1,h2,h3);
			add_apply(h3,h4);
			}
		t_VECTOR_EXPONENT(S_V_I(pv,i),h3);
		for(j=(INT)0;j<S_PA_LI(h3);j++)
			{
			fakul(S_PA_I(h3,j),h2);
			div(h4,h2,h4);
			}
		add(h4,result,result);
		}
	}
	SYMfreeall(h1); SYMfreeall(h2); SYMfreeall(h3); SYMfreeall(h4);
	SYMfreeall(lp);SYMfreeall(pv);
	return(OK);
}


#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

INT stirling_second_number(n,k,result) OP n,k,result;
/* AK 010890 V1.1 */
/* using rekursion */
/* AK 210891 V1.3 */
{
	OP a,b,c,d,e;
	if (negp(n) ) return error("stirling_second_number:neg n");
	if (negp(k) ) return error("stirling_second_number:neg k");
	if (lt(n,k) ) return m_i_i((INT)0,result);
	if (eq(n,k) ) return m_i_i(1L,result);
	if (nullp(n))  return m_i_i((INT)0,result);
	if (nullp(k))  return m_i_i((INT)0,result);
	if (einsp(k))  return m_i_i(1L,result);
	a = callocobject(); b = callocobject(); c = callocobject();
	d = callocobject(); e = callocobject();

	M_I_I(1L,a); 
	copy(n,b);dec(b);
	copy(k,d);dec(d);
	m_i_i((INT)0,result);
	while (lt(a,n))
		{
		binom(b,a,c);
		stirling_second_number(a,d,e);
		mult(c,e,e);
		add(e,result,result);
		inc(a);
		}
	SYMfreeall(a); SYMfreeall(b); SYMfreeall(c); SYMfreeall(d); SYMfreeall(e);
	return OK;
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT stirling_first_tafel(a,b) OP a,b;
{
	INT erg = OK;
	erg += stirling_second_tafel(a,b);
	erg += invers(b,b);
	return erg;
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

INT stirling_second_tafel(a,b) OP a,b;
{
	INT i,j;
	INT erg = OK;
	OP oi=callocobject();
	OP oj=callocobject();
	erg += m_ilih_m(S_I_I(a)+1L,S_I_I(a)+1L,b);
	for (i=(INT)0; i<=S_I_I(a); i++)
		for (j=(INT)0; j<=S_I_I(a); j++)
			{
		M_I_I(i,oi);
		M_I_I(j,oj);
		erg += stirling_second_number_tafel(oi,oj,S_M_IJ(b,i,j),b);
			}
	erg += SYMfreeall(oi); 
	erg += SYMfreeall(oj);
	return erg;
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE

INT stirling_second_number_tafel(n,k,result,t) OP n,k,result,t;
/* AK 010890 V1.1 */
/* using rekursion */
/* AK 210891 V1.3 */
{
	OP a,b,c,d,e;
	if (negp(n) ) return error("stirling_second_number:neg n");
	if (negp(k) ) return error("stirling_second_number:neg k");
	if (lt(n,k) ) return m_i_i((INT)0,result);
	if (eq(n,k) ) return m_i_i(1L,result);
	if (nullp(n))  return m_i_i((INT)0,result);
	if (nullp(k))  return m_i_i((INT)0,result);
	if (einsp(k))  return m_i_i(1L,result);

	if (lt(n,S_M_H(t))) /* wert is in tafel */
		{
		if (not EMPTYP(S_M_IJ(t,S_I_I(n),S_I_I(k))))
			return copy(S_M_IJ(t,S_I_I(n),S_I_I(k)), result);
		}

	a = callocobject(); b = callocobject(); c = callocobject();
	d = callocobject(); e = callocobject();

	M_I_I(1L,a); 
	copy(n,b);dec(b);
	copy(k,d);dec(d);
	m_i_i((INT)0,result);
	while (lt(a,n))
		{
		binom(b,a,c);
		stirling_second_number_tafel(a,d,e,t);
		mult(c,e,e);
		add(e,result,result);
		inc(a);
		}
	SYMfreeall(a); SYMfreeall(b); SYMfreeall(c); SYMfreeall(d); SYMfreeall(e);
	return OK;
}

#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
INT kostka_number_skewpartition(inha,umriss,res) OP inha,umriss,res;
/* AK 131190 V1.1 */ /* AK 210891 V1.3 */
{
	INT	i;
	INT	zaehler = (INT)0;

	INT	len,n,m;
	OP d = callocobject();
	INT *um,*hilf,*ziel,*inh;

	um = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	hilf = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	ziel = (INT *)SYM_malloc(RH_MAX*sizeof(INT));
	inh = (INT *)SYM_malloc(RH_MAX*sizeof(INT));

	conjugate(umriss,d);
	for (i=(INT)0;i<RH_MAX;i++) { 
		hilf[i]=(INT)0; 
		um[i]=(INT)0; 
		ziel[i]=(INT)0; 
		inh[i]=(INT)0; 
		}
	n= S_SPA_GLI(d);
	for(i=1L;i<=n;++i) { 
		um[i]=S_SPA_GII(d,n-i); 
		hilf[i] = um[i]; 
		}
	um[0] = -1L;
	for(i=(INT)0;i<n;++i) {
		um[i+1]=um[1]+i; 
		ziel[i+1]=um[i+1]-hilf[i+1]; 
		}
	m= S_SPA_KLI(d);
/*
	for(i=(INT)0;i<m;++i) { 
		ziel[i+1]=um[i+1]-hilf[i+1]-S_SPA_KII(d,m-i); 
		}
*/
	len = ((S_SPA_GLI(umriss) > S_V_LI(inha)) ? 
		S_SPA_GLI(umriss) : S_V_LI(inha) ) ;

	for (i=1L;i <= S_V_LI(inha); i++) inh[i] = S_V_II(inha,i-1L);
	for (;i<=len;i++) inh[i]=(INT)0;  /* AK 240593 */

	for (i=(INT)0;i<m;i++)
		um[i+1]=um[i+1]-S_SPA_KII(d,m-i-1); /* AK 240593 */
		
	SYMfreeall(d);
	SYM_free(hilf);
	rh_kostka_kostka(um,ziel,inh,(INT)0,(INT)0,inh[1],1L,len,n,&zaehler);
	M_I_I(zaehler,res);
	SYM_free(um);
	SYM_free(inh);
	SYM_free(ziel);
	return(OK);
}
#endif /* KOSTKATRUE */
	
#ifdef KOSTKATRUE
	
static INT kostka_tab_skewpartition(a,b,c) OP a,b,c;
/* Ralf Hager 1989 */ /* a ist skewpartition fuer umriss */
/* b ist vector fuer inhalt */ /* c wird liste mit allen tableau */
/* AK 020890 V1.1 */ /* AK 210891 V1.3 */
{
	INT	i,j;

	INT	*um,*hilf,*ziel,len,n;
	INT	(* tab)[RH_MAX];
	INT	x,*inh,*hilf_zwei,k,m;
	INT	counter = (INT)0;
	OP cp = callocobject();

	tab = (KO_INTARRAY *) SYM_calloc(RH_MAX*RH_MAX,sizeof(INT));
	ziel = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	hilf = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	hilf_zwei = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	inh = (INT *) SYM_malloc(RH_MAX * sizeof(INT));
	um = (INT *) SYM_malloc(RH_MAX * sizeof(INT));

	init(BINTREE,c); /* AK 170392 */

	for (i=1L;i <=S_SPA_GLI(a); i++)
		hilf_zwei[i] = S_SPA_GII(a,S_SPA_GLI(a)-i);
	x = S_SPA_GLI(a);
	n = hilf_zwei[1];
	um[1] =  k = x;
	j = 2L;
	while(k >= 1L)
		{
		counter = (INT)0;
		for(i=j;i<=hilf_zwei[k];++i) { counter++; um[i] = x; }
		k--;
		x=k;
		j+= counter;
		}
	for(i=1L;i<=n;++i) hilf[i] = um[i];
	um[0] = -1L;
	for(i=(INT)0;i<n;++i)
		{ um[i+1] = um[1]+i; ziel[i+1] = um[i+1] - hilf[i+1]; }
	m= S_SPA_KLI(a);
	conjugate(S_SPA_K(a),cp);
	m = S_PA_LI(cp);
	for(i=(INT)0;i<m;++i) { 
		for (j=(INT)0;j<S_PA_II(cp,m-i-1); j++)
				{
				tab[i+1][j+1]=   -7L;  
				} 
		}
	for(i=(INT)0;i<m;++i) { 
		 um[i+1]=um[i+1]-S_PA_II(cp,m-i-1);   
			}
	len = ((S_SPA_GLI(a) > S_V_LI(b)) ? S_SPA_GLI(a) : S_V_LI(b) ) ;
	for (i=1L;i <= S_V_LI(b); i++) inh[i] = S_V_II(b,i-1L);
	for (;i<=len;i++) inh[i]=(INT)0;  /* AK 240593 */
	SYM_free(hilf);
	SYM_free(hilf_zwei);
	
	rh_kostka(tab,um,ziel,inh,(INT)0,(INT)0,inh[1],1L,
		len,n,um[1]+S_PA_II(cp,m-1),c,a);
	SYMfreeall(cp);
	t_BINTREE_LIST(c,c); /* AK 170392 */
	SYM_free(um);
	SYM_free(ziel);
	SYM_free(inh);
	SYM_free(tab);
	return(OK);
	
}
#endif /* KOSTKATRUE */
