/* SYMMETRICA 	nb.c */
/* 4.11.91: TPMcD */

#include       <math.h>
#include       <ctype.h>   /* for isspace AK 160192 */

#undef div3 
#define div3 SYM_AK_div  /* wg. math.h */

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



#define  nb_ganzdiv(a,b,c) ganzdiv(a,b,c) /* AK 201092 */

#define  nb_quores(a,b,c,d) quores(a,b,c,d) /* AK 050393 */

static INT      space_saving = TRUE;
static INT	basis_type = STD_BASIS;

/*	STATIC VARIABLES RELATING TO THE MAINTENANCE OF CYCLOTOMIC DATA	*/

#ifdef	CYCLOTRUE

/*	cyclo_table points to an array of CYCLO_DATA with 	*/
/*	no_cyclos cyclos.  cyclo_table_set is a flag which	*/
/*	indicates whether the table is present or not.		*/

static	INT	cyclo_table_set = 0L, cyclo_list_set = 0L;
static	INT	zzno_cyclos;
static	CYCLO_DATA	*zzcyclo_table;
static	OP	zzcyclo_list = NULL, zzcyclo_tail = NULL;
static INT number_mem;

#endif /* CYCLOTRUE */

static INT setup_prime_table();
static INT integer_factor_0();
static INT integer_factor_1();
static INT insert_zero_into_monopoly();
static INT integer_coefficients();
static INT find_sqrad_data();
static INT adjust_sqrad_data();
static INT fprint_sqrad();
static INT fprint_cyclo();
static INT standardise_cyclo_0();
static INT make_index_monopoly_cyclo();
static INT add_cyclo_cyclo_0();
static INT mult_cyclo_cyclo_0();
static INT invers_cyclo_norm();
static INT SCMPCO();

# ifdef	CYCLOTRUE

static INT setup_cyclotomic_table();
static CYCLO_DATA *cyclo_ptr();
static CYCLO_DATA *add_cyclo_data();
static INT free_cyclo_list();
static INT free_cyclo_table();

# endif
OP s_n_s(a) OP a;
/* AK 080891 V1.3 */
{	
	if (a == NULL)
	{	
		error("s_n_s:a == NULL");
		return (OP) NULL;
	}
	return (((a)->ob_self).ob_number)->n_self;
}

INT c_n_s(a,b) OP a,b;
/* AK 200891 V1.3 */
{ 	
	((a->ob_self).ob_number)->n_self = b;
	return OK;
}

OP s_n_d(a) OP a;
/* AK 200891 V1.3 */
{	
	if (a == NULL)
	{	
		error("s_n_d:a == NULL");
		return (OP) NULL;
	}
	return (((((a)->ob_self).ob_number)->n_data).o_data);
}

INT c_n_d(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	((((((a)->ob_self).ob_number)->n_data).o_data) = (b));
	return OK;
}

static CYCLO_DATA * s_n_dc(a) OP a;
/* AK 200891 V1.3 */
{	
	return (((((a)->ob_self).ob_number)->n_data).c_data);
}

OP s_n_dci(a) OP a;
/* AK 200891 V1.3 */
{	
	return ((((((a)->ob_self).ob_number)->n_data).c_data)->index);
}

OP s_n_dcd(a) OP a;
/* AK 200891 V1.3 */
{	
	return ((((((a)->ob_self).ob_number)->n_data).c_data)->deg);
}

OP s_n_dcp(a)OP a;
/* AK 200891 V1.3 */
{	
	return  ((((((a)->ob_self).ob_number)->n_data).c_data)->poly);
}

/******************		factors.c		**********************/
/* 26.07.91: TPMcD.										     */
/*************************************************************/
/*	Determines and returns the number of digits of the	*/
/*	integer a. a may be an INTEGER  or a LONGINT.		*/

INT number_of_digits(a) OP a;
/* 04.04.90: TPMcD */
/* AK 200891 V1.3 */
{	
	INT	i = 1L;
	OP	b = callocobject();	
	OP ten = callocobject();

	M_I_I(10L,ten);
	copy(a,b);
	if (LT(b,cons_null) == TRUE)
		addinvers_apply(b);

	while (GE(b,ten) == TRUE)
	{	
		nb_ganzdiv(b,ten,b); 
		i++; 
	}
	SYMfreeall(b); 
	SYMfreeall(ten);
	return(i);
}

INT integer_factors_to_integer(l,a) OP l,a;
/* 10.05.90: TPMcD */
/* AK 200891 V1.3 */
/* 01.10.91: TPMcD */
{	
	INT	ret	= ERROR;
#ifdef	MONOPOLYTRUE
	OP	b = callocobject();
	OP	ptr;

	if (S_O_K(l) != MONOPOLY)
		goto exit_label;
	if (not EMPTYP(a))
		freeself(a);
	M_I_I(1L,a);
	ptr	= l;
	if (EMPTYP(S_PO_S(ptr)))
		ptr	= S_L_N(ptr);	/* skip the empty term	*/
	while (ptr != NULL)
	{	
		hoch(S_PO_S(ptr),S_PO_K(ptr),b);
		mult(a,b,a);
		ptr	= S_L_N(ptr);
	}
	ret	= OK;
exit_label:
	SYMfreeall(b);
#else
	error("integer_factors_to_integer: MONOPOLY not available");
#endif
	return(ret);
}

/*Given the number n, which should be an positive INTEGER or LONGINT	*/
/*or a MONOPOLY representing a factorisation of an integer greater	*/
/*than 1 , the result returns the list of positive integers coprime to n.*/

INT make_coprimes(number,result) OP number, result;
/* 01.05.91: TPMcD */ /* AK 200891 V1.3 */ /* 01.10.91: TPMcD */
{	
	INT	end_flag = 0L, flag= -1L; /* AK 040292 */
	INT	ret	= ERROR;
	OP	ptr, ptr_zwei, ptr_drei, num;
#ifdef MONOPOLYTRUE
	OP	new, list;
	OP	vec = callocobject(), prime = callocobject();
	OP	count_eins = callocobject(), count_zwei = callocobject();

	init(SYMLIST,result);
	if (S_O_K(number) == MONOPOLY)
	{	
		list	= number;
		num	= callocobject();
		flag	= 1L;	/* remember to free num	*/
		integer_factors_to_integer(list,num);
	}
	else
	{	
		if (S_O_K(number) != INTEGER && S_O_K(number) != LONGINT
		    || LT(number,cons_eins) == TRUE)
			goto exit_label;
		if (EQ(number,cons_eins) == TRUE)
		{	
			new	= callocobject();
			M_I_I((INT)1,new);
			insert(new,result,NULL,NULL);
			ret	= OK;
			goto exit_label;
		}
		num	= number;
		list	= callocobject();
		flag	= 0L;	/* remember to free list	*/
		integer_factor(num,list);
	}
	m_i_i((INT)1,count_eins);
	init(SYMLIST,vec);
	ptr	= vec;
	while (TRUE)
	{	/*	vec is initialised to the list of numbers 1 , . . ., num	*/
		S_L_S(ptr)	= callocobject();
		copy(count_eins,S_L_S(ptr));
		if (LT(count_eins,num) == TRUE)
		{	
			new	= callocobject();
			S_L_N(ptr)	= new;
			ptr	= new;
			init(SYMLIST,new);
			inc(count_eins);
		}
		else
		{	
			S_L_N(ptr)	= NULL;
			break;
		}
	}
	ptr	= list;
	while (ptr != NULL)
	{	
		copy(S_PO_S(ptr),prime);
		copy(cons_eins,count_eins);
		copy(cons_eins,count_zwei);
		ptr_zwei	= vec;
		while (LE(count_eins,num) == TRUE)
		{	/*	delete all multiples of prime from vec	*/
			if (EQ(count_zwei,prime) == TRUE)
			{	
				copy(cons_eins,count_zwei);
				if (not EMPTYP(S_L_S(ptr_zwei))) /* AK */
					freeself(S_L_S(ptr_zwei));
			}
			else
				inc(count_zwei);
			inc(count_eins);
			ptr_zwei	= S_L_N(ptr_zwei);
		}
		ptr	= S_L_N(ptr);
	}
	ptr	= result;
	ptr_drei	= result;
	copy(cons_eins,count_eins);
	ptr_zwei	= vec;
	while (TRUE)
	{	
		if (EQ(count_eins,num) == TRUE)
			end_flag	= 1L;
		if (not EMPTYP(S_L_S(ptr_zwei)))
		{	
			S_L_S(ptr)	= callocobject();
			copy(count_eins,S_L_S(ptr));
			if (end_flag)
			{	
				S_L_N(ptr)	= NULL;
				break;
			}
			else
			{	
				new	= callocobject();
				init(SYMLIST,new);
				S_L_N(ptr)	= new;
				ptr_drei	= ptr;
				ptr	= new;
			}
		}
		if (end_flag)
		{	
			SYMfreeall(ptr);
			S_L_N(ptr_drei)	= NULL;
			break;
		}
		inc(count_eins);
		ptr_zwei	= S_L_N(ptr_zwei);
	}
	ret	= OK;
exit_label:
	SYMfreeall(vec); 
	SYMfreeall(prime); 
	SYMfreeall(count_eins); 
	SYMfreeall(count_zwei);
	if (flag == 1L) SYMfreeall(num);
	else  if (flag != -1L) SYMfreeall(list); /* AK 040292 */
#endif
	return(ret);
}

INT euler_phi(a,b) OP a,b;
/* AK number of numbers coprime to a */
/* AK 310191 V1.2 */ /* AK 200891 V1.3 */
{	
	OP c = callocobject();
	INT erg;
	erg	= make_coprimes(a,c);
	erg += length(c,b);
	erg += SYMfreeall(c);
	return erg;
}

INT primep(a) OP a;
/* AK 220294 true if prime */
{
	OP c,d,e;
	INT erg = TRUE;

	if (eq(a,cons_zwei))
		{
		erg = TRUE;
		goto p1;
		}
	if (negp(a) || nullp(a) || even(a) )
		{
		erg = FALSE; 
		goto p1;
		}
	c = callocobject();
	d = callocobject();
	e = callocobject();
	
	ganzsquareroot(a,c);
	M_I_I((INT)3,d);
	while (le(d,c))
		{
		mod(a,d,e);
		if (nullp(e) ) 
			{ erg = FALSE; break; } 
		add_apply(cons_zwei,d);
		}
	SYMfreeall(c);
	SYMfreeall(d);
	SYMfreeall(e);
p1:
	return erg;
}

/*	INTEGER SQUARE ROOTS	*/

/*	If a is a non-negative integer (INTEGER or LONGINT)	*/
/*	s is set to the integer part of its square root.	*/
/*	In this case, the return value is OK or IMPROPER	*/
/*	according as the integer is a perfect square or not.	*/
/*	Otherwise, the return value is ERROR.			*/

static INT square_root(a,s) OP a,s;
/* 04.04.90: TPMcD */ /* AK 200891 V1.3 */
{	
	INT	a_eins,d_eins,e_eins,ret	= ERROR;
	OP	b = callocobject();	
	OP	c = callocobject();
	OP	d = callocobject();	
	OP	e = callocobject();
	OP	diff = callocobject();

	if (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
		goto exit_label;
	if (negp(a))	/* a < 0L */
	{	
		fprintf(stderr,"Negative number has no real square root\n");
		goto exit_label;
	}
	if (nullp(a))
	{	
		m_i_i(0l,s);
		ret	= OK;
		goto exit_label;
	}
	d_eins	= number_of_digits(a);
	e_eins	= (d_eins + 1L) / 2L;
	M_I_I(10L,d);
	M_I_I(e_eins-1L,b);
	hoch(d,b,b);
	mult(d,b,c);
	mult(b,b,d);
	if (EQ(a,d) == TRUE)
	{	
		copy(b,s);
		ret	= OK;
		goto exit_label;
	}
	do
	{	
		add(b,c,d);
		if (negp(d))
			error("square_root : negative integer unexpectedly encountered\n");
		nb_ganzdiv(d,cons_zwei,d);
		addinvers(b,diff);
		add_apply(c,diff);
		mult(d,d,e);
		a_eins	= comp(a,e);
		if (a_eins < 0L)
			copy(d,c);
		else if (a_eins > 0L)
			copy(d,b);
		else
		{	
			copy(d,s);
			ret	= OK;
			goto exit_label;
		}
	}		while (GE(diff,cons_zwei) == TRUE);
	copy(b,s);
	ret = IMPROPER;
exit_label:
	SYMfreeall(b); 
	SYMfreeall(c); 
	SYMfreeall(d); 
	SYMfreeall(e); 
	SYMfreeall(diff);
	return(ret);
}

#ifdef LONGINTTRUE
INT ganzsquareroot_longint(a,b) OP a,b;
/* AK 040291 */ /* AK 200891 V1.3 */
{
	INT erg ;
	erg = square_root(a,b);
	return (erg == IMPROPER ? OK : erg); /* AK 200194 */
}
#endif /* LONGINTTRUE */

INT ganzsquareroot_integer(a,b) OP a,b;
/* AK 040291 */ /* AK 200891 V1.3 */
{
	INT erg ;
	erg = square_root(a,b);
	return (erg == IMPROPER ? OK : erg); /* AK 200194 */
}

/*  INTEGER FACTORISATION	*/

/*	Routines for prime factorization of integers.	*/
/*	prime_table points to an array of INT with the first no_primes primes.*/
/*	prime_table_set is a flag which indicates whether the table is present*/
/*	or not.		*/

static INT	prime_table_set	= 0L, no_primes;
static INT  *prime_table;

/*Reads the table of primes from the file PRIMES.DAT. The first entry	*/
/*should be no_primes, then the list of primes.  Assumes that INT means	*/
/*long int.  Returns OK if the table is set; otherwise, returns ERROR.	*/

static INT setup_prime_table()
/* 040490 TPMcD */
/* AK 200891 V1.3 */
/* 29.10.91 TPMcD */
{
# ifdef PRIMES_FILE

	FILE	*f;
	if ( (f = fopen("PRIMES.DAT","r")) == NULL ||
	    fscanf(f," %ld",&no_primes) == 0 || no_primes < 1L ||
	    (prime_table = (INT *)SYM_calloc((int)no_primes,sizeof(INT))) == NULL )
	{	
		no_primes	= 0L;
		return(ERROR);
	}
	for (i=0L;i<no_primes;i++)
		if (fscanf(f," %ld",&prime_table[i]) != 1)
		{	
			SYM_free(prime_table);
			no_primes	= 0L;
			return(ERROR);
		}
	prime_table_set	= 1L;
# else
	no_primes	= 15L;
	if ((prime_table = (INT *)SYM_calloc((int)no_primes,sizeof(INT))) == NULL )
	{	
		no_primes	= 0L;		/* The previous version had incompatible */
		return(ERROR);			/* uses for prime_table in the two parts */
	}							/* of the #ifdef construct */
	prime_table[0] = 2L;
	prime_table[1] = 3L;
	prime_table[2] = 5L;
	prime_table[3] = 7L;
	prime_table[4] = 11L;
	prime_table[5] = 13L;
	prime_table[6] = 17L;
	prime_table[7] = 19L;
	prime_table[8] = 23L;
	prime_table[9] = 29L;
	prime_table[10] = 31L;
	prime_table[11] = 37L;
	prime_table[12] = 41L;
	prime_table[13] = 43L;
	prime_table[14] = 47L;
	prime_table_set	= 1L;

# endif /* PRIMES_FILE */

	return(OK);
}

/*	This routine factorizes an integer using the table of primes.	*/
/*	a -- the integer to be factored;				*/
/*	l -- a list in which the prime factors of a, which are contain-	*/
/*	ed in the table, and their exponents are inserted as monomials	*/
/*	with the primes as the selfs and the exponents as the koeffs;	*/
/*	g -- the remaining factor;					*/
/*	m -- the last number tried as a factor.				*/
/*	first_prime -- the variable to point to the first prime factor	*/
/*	if that is all that is required. For a full factorization, it	*/
/*	must be set to NULL.						*/
/*	l must be a MONOPOLY. a,l,g,m and first_prime must be different.	*/

#ifdef	MONOPOLYTRUE
static INT integer_factor_0(a,l,g,m,first_prime) OP a,l,g,m, first_prime;
/* 04.04.90: TPMcD */
/* AK 200891 V1.3 */
{	
	INT	i,ret	= ERROR;
	OP	b = callocobject(), c = callocobject(), d = callocobject(),
	    e = callocobject(), k = callocobject(), f;

	if (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
		goto exit_label;
	if (S_O_K(l) != MONOPOLY)
		goto exit_label;
	if (a == b || a == c || a == l || a == first_prime || b == c || b == l
	    || a == first_prime  || c == l || c == first_prime|| l == first_prime)
		goto exit_label;
	copy(a,b);
	if (EQ(b,cons_eins) == TRUE)
	{	
		f	= callocobject();
		m_sk_mo(cons_eins,cons_eins,f);
		insert(f,l,add_koeff,NULL);
	}
	else if (LT(b,cons_null) == TRUE)
	{	
		addinvers_apply(b); /* AK 090891 */
		f	= callocobject();
		M_I_I(-1L,c);
		m_sk_mo(c,cons_eins,f);
		insert(f,l,add_koeff,NULL);
	}
	if (EQ(b,cons_eins) == TRUE)
	{	
		ret	= OK;
		copy(b,g);
		copy(b,m);
		goto exit_label;
	}
	square_root(b,e); /* e	= sqrt(a) */
	if (!prime_table_set)
		if (setup_prime_table() == ERROR) goto exit_label;
	for (i=0L;i<no_primes;i++)
	{	
		copy(cons_null,k);
		/* 29.10.91: TPMcD: type of prime_table changed back to INT[] */
		m_i_i((INT)prime_table[i],c);
		if (GT(c,e) == TRUE)	/*	all primes not greater than	*/
		{						/*	sqrt(b) have been tried.	*/
			if (first_prime != NULL)
			{	
				copy(b,first_prime);
				ret	= OK;
				goto exit_label;
			}
			f	= callocobject();
			m_i_i(1L,d);
			m_sk_mo(b,d,f);
			insert(f,l,add_koeff,NULL);
			m_i_i(1L,b);
			break;
		}
		mod(b,c,d);

		while(nullp(d))
		{	
			if (first_prime != NULL)
			{	
				copy(c,first_prime);
				ret	= OK;
				goto exit_label;
			}
			inc(k);
			nb_ganzdiv(b,c,b);
			mod(b,c,d);
			square_root(b,e); /* e	= sqrt(b) */
		}
		if (GT(k,cons_null) == TRUE)
		{	
			f	= callocobject();
			m_sk_mo(c,k,f);
			insert(f,l,add_koeff,NULL);
		}
		if (EQ(b,cons_eins) == TRUE)
			break;
	}
	ret	= OK;
	copy(b,g); 
	copy(c,m);
exit_label:
	SYMfreeall(b); 
	SYMfreeall(c); 
	SYMfreeall(d); 
	SYMfreeall(e); 
	SYMfreeall(k);
	return(ret);
}
#endif /* MONOPOLYTRUE */

/*	This routine finds all prime factors between two bounds				*/
/*	a -- the integer to be factored;									*/
/*	l -- a list in which the prime factors of a, between the given		*/
/*	bounds, and their exponents are inserted as monomials				*/
/*	with the primes as the selfs and the exponents as the koeffs;		*/
/*	if l is not a MONOPOLY, it is initialised to one;					*/
/*	b -- the remaining factor;											*/
/*	f_eins -- the lower bound on trial factors.								*/
/*	If it is even, it is replaced by f_eins+1.								*/
/*	f_zwei -- the upper bound on trial factors.								*/
/*	first_prime -- the variable to point to the first prime factor		*/
/*	if that is all that is required. For a full factorization, it		*/
/*	must be set to NULL.												*/
/*	l must be a MONOPOLY. a,l,b,f_eins,f_zwei,first_prime must be different.	*/

static INT integer_factor_1(a,f_eins,f_zwei,b,l,first_prime) OP a,f_eins,f_zwei,b,l,first_prime;
/* 04.04.90: TPMcD */
/* AK 200891 V1.3 */
{	
	INT	flag = 1L;
	INT	ret = ERROR, new_factor = 0L, first = 1L;
#ifdef	MONOPOLYTRUE
	OP	c = callocobject(), f = callocobject(), e = callocobject(),
	    e_eins = callocobject(), q = callocobject(), r = callocobject(),
	    k, g;
	if (S_O_K(l) != MONOPOLY)
		init(MONOPOLY,l);
	copy(a,c);
	if (LT(c,cons_null) == TRUE)
	{	
		addinvers(c,c);
		M_I_I(1L,f);
		M_I_I(-1L,e);
		k = callocobject();
		m_sk_mo(e,f,k);
		insert(k,l,add_koeff,NULL);
	}
	k	= callocobject();
	copy(f_zwei,e);
	copy(f_eins,f);
	if (LT(f,cons_eins) == TRUE)	/* Make the initial divisor >= 2 */
		copy(cons_zwei,f);
	nb_quores(f,cons_zwei,q,r);
	if (nullp(r))
	{	
		if (einsp(q)) /*	f = 2	*/
			flag = 0L;
		else	/*	f is even and greater than 2 */
			inc(f);
	}
	nb_quores(c,f,q,r);

	while (LE(f,e) == TRUE)
	{	
		while (nullp(r))
{	/* The value of c entering this loop is divisible
			   by f exactly k times, where k refers to its
					   value exiting the loop. */
			if (first_prime != NULL)
			{	
				copy(f,first_prime);
				ret	= OK;
				goto exit_label;
			}
			if (first)
			{	
				M_I_I(1L,k);
				new_factor	= 1L;
				first	= 0L;
			}
			else
				inc(k);
			nb_ganzdiv(c,f,c);
			nb_quores(c,f,q,r);
		}
		if (new_factor)
		{	/* make new monomial and insert in the factor list */
			g	= callocobject();
			m_sk_mo(f,k,g);
			insert(g,l,add_koeff,NULL);
			new_factor	= 0L;
			if (EQ(c,cons_eins) == TRUE)
				break;
			square_root(c,e_eins);
			/* reduce the upper limit of the trial factors */
			if (LT(e_eins,e) == TRUE)
				copy(e_eins,e);
			/*	the current c is a prime or it has prime factors	*/
			/*	are less than f_eins, and the factorization is 'complete'.	*/
			if (LT(e,f) == TRUE)
				break;
		}
		first	= 1L;
		/* Increase f by 2 and find corresponding q and r */
		inc(f);
		if (flag) inc(f);
		flag	= 1L;
		nb_quores(c,f,q,r);
	}
	copy(c,b);
	ret	= OK;
exit_label:
	SYMfreeall(c); 
	SYMfreeall(q); 
	SYMfreeall(r); 
	SYMfreeall(f); 
	SYMfreeall(k);
	SYMfreeall(e); 
	SYMfreeall(e_eins);
#else /* MONOPOLYTRUE */
	error("integer_factor_1: MONOPOLY not available");
#endif /* MONOPOLYTRUE */
	return(ret);
}

/*	This is the main integer factorization routine.		*/
/*	a -- the integer to be factored;			*/
/*	l -- a list in which the prime factors of a and their exponents	*/
/*	are inserted as monomials with the primes as the selfs and the	*/
/*	exponents as the koeffs. l need not be initialized to a MONOPOLY.	*/

INT integer_factor(a,l) OP a,l;
/* 040490: TPMcD */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	ret	= ERROR;

#ifdef	MONOPOLYTRUE
	OP	b = callocobject(), c = callocobject(), d = callocobject(),
	    e = callocobject();

	if (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
		goto exit_label;
	init(MONOPOLY,l);

	/*First factorize using the list of primes in "PRIMES.DAT"	*/

	if (integer_factor_0(a,l,b,c,NULL) != OK)
	{	
		copy(a,b);
		M_I_I(1L,c);
	}
	if (EQ(b,cons_eins) == TRUE)	/*	Factorization complete.		*/
	{	
		ret	= OK;
		goto exit_label;
	}
	copy(b,d);
	if (integer_factor_1(b,c,d,e,l,NULL) == OK)
	{
		/*	If e > 1 , it is a prime greater than those in l	*/
		m_i_i(1L,c);
		if (gt(e,c) == TRUE)
		{	
			m_sk_mo(e,c,d);
			insert(d,l,add_koeff,NULL);
			m_i_i(1L,e);
			d	= callocobject();
		}
		ret	= OK;
	}
	else
		printf("\ninteger_factor: factorization error");
exit_label:
	SYMfreeall(b); 
	SYMfreeall(c); 
	SYMfreeall(d); 
	SYMfreeall(e);
#else /* MONOPOLYTRUE */
	error("integer_factor: MONOPOLY not available");
#endif /* MONOPOLYTRUE */
	return(ret);
}

/*	This routine finds the smallest prime factor of an integer.	*/
/*	a -- the integer; first_prime -- its smallest prime factor.	*/

INT first_prime_factor(a,first_prime) OP a,first_prime;
/* 04.04.90: TPMcD */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	ret	= ERROR;
#ifdef	MONOPOLYTRUE
	OP	b = callocobject();	
	OP	c = callocobject();
	OP	d = callocobject();	
	OP	e = callocobject();
	OP	l = callocobject();

	if (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
		goto exit_label;
	init(MONOPOLY,l);
	m_i_i(1L,first_prime);
	copy(a,d);
	if (LT(d,cons_null) == TRUE)
		addinvers(d,d);
	if (einsp(d))
	{	
		ret	= OK;
		goto exit_label;
	}
	if (integer_factor_0(d,l,b,c,first_prime) == OK)
		if (einsp(first_prime))
			if (integer_factor_1(d,c,d,e,l,first_prime) != OK
			    || einsp(first_prime))
				goto exit_label;
	ret	= OK;
exit_label:
	if (ret != OK)
		printf("\nfirst_prime_factor: factorization error");
	SYMfreeall(b); 
	SYMfreeall(c); 
	SYMfreeall(d); 
	SYMfreeall(e); 
	SYMfreeall(l);
#else
	error("integer_factor: MONOPOLY not available");
#endif
	return(ret);
}

/*	SQUARE-FREE PARTS	*/

/*	This routine find the square-free part of the integer, which is		*/
/*	given as a prime factors list.										*/
/*	la -- a MONOPOLY containing the prime factorization of the integer 	*/
/*	lb, lc -- return the MONOPOLYs containing the prime factorization 	*/
/*	of the square-free and square parts, respectively.					*/
/*	The parameters la,lb,lc must be distinct.							*/

INT square_free_part_0(la,lb,lc) OP la,lb,lc;
/* 14.06.90: TPMcD */
/* AK 200891 V1.3 */
{	
	INT	ret	= ERROR;
	INT	flag_b	= 1L, flag_c	= 1L;
#ifdef	MONOPOLYTRUE
	OP	u = callocobject(), x = callocobject(), y = callocobject(),
	    z = callocobject(), ptr, w;

	if (S_O_K(la) != MONOPOLY)
		goto exit_label;
	ptr	= la;
	init(MONOPOLY,lb); 
	init(MONOPOLY,lc);
	while (ptr != NULL)
	{	
		copy(S_PO_S(ptr),u);	/*	the prime		*/
		copy(S_PO_K(ptr),x);	/*	the exponent	*/
		if (negp(x))
			error("square_free_part_0 : unexpected negative exponent");
		nb_quores(x,cons_zwei,z,y);
		if (nullp(y))			/*	even power		*/
		{	
			w	= callocobject();
			m_sk_mo(u,z,w);
			insert(w,lc,add_koeff,NULL);
			flag_c	= 0L;
		}
		else
		{	
			if (not nullp(z))
			{	
				w	= callocobject();
				m_sk_mo(u,z,w);
				insert(w,lc,add_koeff,NULL);
				flag_c	= 0L;
			}
			w	= callocobject();
			m_sk_mo(u,cons_eins,w);
			insert(w,lb,add_koeff,NULL);
			flag_b	= 0L;
		}
		ptr	= S_L_N(ptr);
	}
	if (flag_b)
	{	
		w	= callocobject();
		m_sk_mo(cons_eins,cons_eins,w);
		insert(w,lb,add_koeff,NULL);
	}
	if (flag_c)
	{	
		w	= callocobject();
		m_sk_mo(cons_eins,cons_eins,w);
		insert(w,lc,add_koeff,NULL);
	}
	ret	= OK;
exit_label:
	SYMfreeall(u); 
	SYMfreeall(x); 
	SYMfreeall(y); 
	SYMfreeall(z);
#else
	error("square_free_part_0: MONOPOLY not available");
#endif
	return(ret);
}

/*	This routine find the square-free part of the integer, i.e. the	*/
/*	product of the prime factors (and -1 , if the integer is < 0.	*/
/*	a -- the integer, it is either an INTEGER, LONGINT or a		*/
/*	MONOPOLY containing the prime factorization of an integer.	*/
/*	b -- the square-free part.		a	= b * c  2		*/
/*	c -- the square-root of the square part.			*/
/*	la -- returns a MONOPOLY containing the prime factorization of	*/
/*	a if a is not a MONOPOLY and la is not NULL.			*/
/*	lb, lc -- returns the MONOPOLYs containing the prime		*/
/*	factorizations of b and c.					*/
/*	The parameters a,b,c must be distinct.  If la,lb,lc are not	*/
/*	NULL they must be distinct also.				*/

INT square_free_part(a,b,c,la,lb,lc) OP a,b,c,la,lb,lc;
/* 14.06.90: TPMcD */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	ret	= ERROR;
#ifdef	MONOPOLYTRUE
	OP	la_tmp, lb_tmp, lc_tmp;

	if (S_O_K(a) == INTEGER || S_O_K(a) == LONGINT)
	{	
		if (la == NULL)
			la_tmp	= callocobject();
		else
			la_tmp	= la;
		init(MONOPOLY,la_tmp);
		integer_factor(a,la_tmp);
	}
	else if (S_O_K(a) == MONOPOLY)
		la_tmp	= a;
	else
		goto exit_label;
	if (lb == NULL)
		lb_tmp	= callocobject();
	else
		lb_tmp	= lb;
	init(MONOPOLY,lb_tmp);
	if (lc == NULL)
		lc_tmp	= callocobject();
	else
		lc_tmp	= lc;
	init(MONOPOLY,lc_tmp);
	square_free_part_0(la_tmp,lb_tmp,lc_tmp);
	integer_factors_to_integer(lb_tmp,b);
	integer_factors_to_integer(lc_tmp,c);
	ret	= OK;
exit_label:
	if (la == NULL && la_tmp != a) SYMfreeall(la_tmp);
	if (lb == NULL) SYMfreeall(lb_tmp);
	if (lc == NULL) SYMfreeall(lc_tmp);
#else
	error("square_free_part: MONOPOLY not available");
#endif
	return(ret);
}

/*
	The Jacobi Symbol: (a/b) b odd.
	a and b are integers. c must point to a location different from a and b.
	if a and b have a common factor, c is set to 0 and ERROR is returned.
	otherwise, c is set to the the jacobi symbol (a/b). Note that b must
	be odd.
*/

INT jacobi(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
{	
	OP	x =callocobject(), y = callocobject(), z = callocobject(),
	    w = callocobject(), y_eins = callocobject(), y_zwei = callocobject(),
	    z_eins = callocobject(), z_zwei = callocobject(),
	    four = callocobject(), eight	= callocobject();
	INT	ret	= ERROR;
	INT	d, f = 0L;

	if (c == a || c == b)
		goto exit_label;
	copy(cons_null,c);
	if ((S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
	    || (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT))
		goto exit_label;
	if (even(b))
	{	
		printf("Jacobi Symbol: Second integer must be odd\n");
		goto exit_label;
	}
	M_I_I(4L,four);
	M_I_I(8L,eight);
	copy(a,x);
	copy(b,y);
	if (negp(y))
		addinvers_apply(y);
	while (NEQ(y,cons_eins))
	{	
		mod(x,y,z);
		if (nullp(z))	/*	The numbers not relatively prime*/
			goto exit_label;
		if (odd(z))
		{	
			addinvers(y,w);
			add(z,w,z);
		}
		d		= 0L;
		while (even(z))
		{	
			d	= 1L - d;
			nb_ganzdiv(z,cons_zwei,z);
			if (nullp(z))	/*The numbers not relatively prime*/
				goto exit_label;
		}
		copy(y,x);
		copy(y,y_eins);
		dec(y_eins);
		mod(y_eins,eight,y_zwei);
		copy(z,z_eins);
		dec(z_eins);
		mod(z_eins,eight,z_zwei);
		mult(y_zwei,z_zwei,y_eins);
		mod(y_eins,eight,y_eins);
		if (GE(y_eins,four))
			f	= 1L - f;
		if (d)	/* an odd power of two */
		{	
			inc(y);
			mod(y,eight,y_eins);
			if (GE(y_eins,four))
				f	= 1L - f;
		}
		if (negp(z))
			addinvers_apply(z);
		copy(z,y);
	}
	copy(cons_eins,c);
	if (f)
		addinvers_apply(c);
	ret	= OK;
exit_label:
	SYMfreeall(x); 
	SYMfreeall(y); 
	SYMfreeall(z); 
	SYMfreeall(w);
	SYMfreeall(y_eins); 
	SYMfreeall(y_zwei); 
	SYMfreeall(z_eins); 
	SYMfreeall(z_zwei);
	SYMfreeall(four); 
	SYMfreeall(eight);
	return(ret);
}

/*
	The Kronecker Symbol: (a/b). a square-free and congruent to 0 or 1 mod 4.
	a and b are integers. c must point to a location different from a and b.
	if a and b have a common factor, c is set to 0 and ERROR is returned.
	otherwise, c is set to the the jacobi symbol (a/b). Note that b must
	be odd.
*/

INT kronecker(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
{	
	INT	flag	= 0L;
	INT	ret	= ERROR;
	OP	a_eins = callocobject(), a_zwei = callocobject(), b_null = callocobject(),
	    b_eins = callocobject(), b_zwei = callocobject(), b_drei = callocobject(),
	    four = callocobject();

	if (c == a || c == b || nullp(a) || nullp(b))
		goto exit_label;
	copy(a,a_eins);
	copy(b,b_eins);
	if (negp(b_eins))
		addinvers_apply(b_eins);
	M_I_I(4L,four);
	copy(cons_null,c);
	mod(a_eins,four,a_zwei);
	if (nullp(a_zwei))
		flag	= 1L;
	else if (!einsp(a_zwei))
		goto exit_label;
	nb_quores(b_eins,cons_zwei,b_zwei,b_drei);
	copy(cons_null,b_null);
	if (nullp(b_drei))	/*	b is even.	*/
	{	
		if (flag)	/*	a is even also.	*/
			goto exit_label;
		do
		{	
			inc(b_null);
			copy(b_zwei,b_eins);
			nb_quores(b_eins,cons_zwei,b_zwei,b_drei);
		}		while (nullp(b_drei));
	}				/*	b_eins is the largest odd factor of b.	*/
	nb_quores(b_null,cons_zwei,b_null,b_zwei);
	if (nullp(b_zwei))	/*	b is divisible by an odd power of two and a is odd.	*/
	{	
		m_i_i(8L,b_drei);
		mod(a_eins,b_drei,b_zwei);
		if (NEQ(b_zwei,cons_eins))
			flag	= 1L;		/* negate the final value */
	}
	else
		flag	= 0L;
	/*	At this point, b_eins is odd */
	jacobi(a_eins,b_eins,c);
	if (flag)
		addinvers_apply(c);
	ret	= OK;
exit_label:
	SYMfreeall(a_eins); 
	SYMfreeall(a_zwei); 
	SYMfreeall(four);
	SYMfreeall(b_null); 
	SYMfreeall(b_eins); 
	SYMfreeall(b_zwei); 
	SYMfreeall(b_drei);
	return(ret);
}
/******************		fields_0.c		**********************/
/* 26.07.91: TPMcD.										     */
/*************************************************************/

INT eq_fieldobject_int(type,a,i) OBJECTKIND type; OP a; INT i;
/* AK 200891 V1.3 */
{	
	INT	ret = FALSE;
	OP	b = callocobject();
	OP	c = callocobject();
	M_I_I(-i,b);
	switch(S_O_K(a))
	{
#ifdef MONOPOLYTRUE
	case MONOPOLY:		
		add_scalar_monopoly(b,a,c);
		ret	= nullp_monopoly(c);
		break;
#endif /* MONOPOLYTRUE */
#ifdef CYCLOTRUE
	case CYCLOTOMIC:	
		add_scalar_cyclo(b,a,c);
		ret	= nullp_monopoly(S_N_S(c));
		break;
#endif /* CYCLOTRUE */
#ifdef SQRADTRUE
	case SQ_RADICAL:	
		add_scalar_sqrad(b,a,c);
		ret	= nullp_monopoly(S_N_S(c));
		break;
#endif /* SQRADTRUE */
	default:	
		error("eq_fieldobject_int: invalid type\n");
	}
	SYMfreeall(b); 
	SYMfreeall(c);
	return(ret);
}

#ifdef NUMBERTRUE

static struct number * callocnumber()
/* 22.06.90: TPMcD */
/* AK 200891 V1.3 */
{
	struct number *result=(struct number *) 
		SYM_calloc(1,sizeof(struct number));
	if (result == NULL) error("callocnumber:no mem");
	number_mem++;
	return(result);
}
#endif /* NUMBERTRUE */

INT m_ksd_n(kind,self,data,result) OBJECTKIND kind; OP self,data,result;
/* AK 230191 */
/* AK 200891 V1.3 */
{	
	INT erg = ERROR;
#ifdef NUMBERTRUE
	erg = b_ksd_n(kind,callocobject(),callocobject(),result);
	if (S_O_K(self) != MONOPOLY  || kind == SQ_RADICAL && S_O_K(data) != SYMLIST)
		return( error("m_ksd_n: invalid self or data") );
	erg += copy(self,S_N_S(result));
	erg += copy(data,S_N_D(result));
#endif /* NUMBERTRUE */
	return erg;
}

INT init_sqrad(a) OP a;
/* AK 010993 */
{
	INT erg = OK;
	if (not EMPTYP(a))
		return ERROR;
	erg +=  b_ksd_n(SQ_RADICAL, callocobject(), callocobject(), a);
	if (erg != OK)
		EDC("init_sqrad");
	return erg;
}


INT init_cyclo(a) OP a;
/* AK 010993 */
{
	INT erg = OK;
	if (not EMPTYP(a))
		return ERROR;
	erg +=  b_ksd_n(CYCLOTOMIC, callocobject(), NULL, a);
	ENDR("init_cyclo");
}


#ifdef NUMBERTRUE
INT b_ksd_n(kind,self,data,result) OBJECTKIND kind; OP self,data,result;
/* 22.06.90: TPMcD */ /* 3.04.91: TPMcD. */
/* AK 200891 V1.3 */
{
	OBJECTSELF obself;
	if (not EMPTYP(result))
		freeself(result);
	obself.ob_number = callocnumber();
	b_ks_o(kind,obself,result);
	if (EMPTYP(self))
		init(MONOPOLY,self);
	if (kind == SQ_RADICAL && EMPTYP(data))
		init(SYMLIST,data);
	if (S_O_K(self) != MONOPOLY  || 
		kind == SQ_RADICAL && S_O_K(data) != SYMLIST)
			return( error("b_ksd_n: invalid self or data") );
	S_N_S(result)	= self;
	S_N_D(result)	= data;
	return(OK);
}
#endif /* NUMBERTRUE */

INT objectwrite_number(f,number) FILE *f; OP number;
/* AK 200891 V1.3 */
{
#ifdef NUMBERTRUE
	fprintf(f," %ld\n",(INT)S_O_K(number));
	objectwrite(f,S_N_S(number));
	switch (S_O_K(number))
	{	
	case	SQ_RADICAL:
		objectwrite(f,S_N_D(number));
		break;
	case	CYCLOTOMIC:
		objectwrite(f,S_N_DCI(number));
		/*
					objectwrite(f,S_N_DCD(number));
					objectwrite(f,S_N_DCP(number));
*/
		break;
	default:
		error("Invalid number type\n");
	}
	return(OK);
#else /* NUMBERTRUE */
	error("objectwrite_number:NUMBER not available");
	return(ERROR);
#endif /* NUMBERTRUE */
}

INT objectread_number(f,number,type) FILE *f; OP number; OBJECTKIND type;
/* AK 200891 V1.3 */
{
#ifdef NUMBERTRUE
	init(type,number);
	objectread(f,S_N_S(number));
	switch (S_O_K(number))
	{	
	case	SQ_RADICAL:
		objectread(f,S_N_D(number));
		break;
	case	CYCLOTOMIC:
		{	
			OP	index = callocobject();
			objectread(f,index);
			S_N_DC(number)	= add_cyclo_data(index);
		}
		break;
	default:
		error("Invalid number type\n");
	}
	return(OK);
#endif /* NUMBERTRUE */
}

INT fprint_number(f,n) FILE *f; OP n;
/* AK 200891 V1.3 */
{	
	INT	saving;
#ifdef NUMBERTRUE
	switch (S_O_K(n))
	{	
	case	SQ_RADICAL:
		/*	Are all coefficients fractions with denominator 2	*/
		if (S_O_K(S_PO_K(S_N_S(n))) == BRUCH)
		{	
			OP	nn = callocobject();
			saving	= space_saving;
			space_saving = FALSE;
			mult_scalar_sqrad(cons_zwei,n,nn);
			space_saving = saving;
			if (integer_coefficients(S_N_S(nn)) == TRUE)
			{
				fprintf(f," 1/2 (");
				fprint_sqrad(f,nn);
				fprintf(f,")");
				SYMfreeall(nn);
				zeilenposition	+= 7L;
				return(OK);
			}
			SYMfreeall(nn);
		}
		fprintf(f," ( ");
		fprint_sqrad(f,n);
		fprintf(f," )");
		zeilenposition	+= 5L;
		break;
	case	CYCLOTOMIC:
		fprintf(f," ( ");
		fprint_cyclo(f,n);
		fprintf(f," )");
		zeilenposition	+= 5L;
		break;
	default:	
		;
	}
#endif /* NUMBERTRUE */
	return(OK);
}

INT freeself_number(n) OP n;
/* AK 200891 V1.3 */
{
#ifdef NUMBERTRUE
	OBJECTSELF d;
	INT erg = OK;
	d = S_O_S(n);
	erg = SYMfreeall(S_N_S(n));
	if (erg == ERROR)
		return error("freeself_number:error in SYMfreeall S_N_S");

	switch (S_O_K(n))
	{	
	case	SQ_RADICAL:
		if (not EMPTYP(S_N_D(n)))
			SYMfreeall(S_N_D(n));
		else
			error("freeself_number: no data to release");
		break;
	case	CYCLOTOMIC:
		break;
	default:	
		;
	}
	SYM_free(d.ob_number);
	number_mem--;
	C_O_K(n,EMPTY);
#endif /* NUMBERTRUE */
	return OK;
}

INT comp_number(a,b) OP a,b;
/* 21.07.91 TPMcD: still incomplete */
/* AK 200891 V1.3 */
{
#ifdef NUMBERTRUE
	switch (S_O_K(a))
	{	
	case	SQ_RADICAL:
		comp_sqrad(a,b);
		break;
	case	CYCLOTOMIC:
		comp_cyclo(a,b);
		break;
	default:
		return error("comp_number:invalid number type\n");
	}
	return(OK);
#else /* NUMBERTRUE */
	return error("comp_number:NUMBER not available");
#endif /* NUMBERTRUE */
}

INT copy_number(a,b) OP a,b;
/* AK 200891 V1.3 */
{
#ifdef NUMBERTRUE
	if (a == b)
		error("copy_number: First and second arguments are the same\n");
	init(S_O_K(a),b);
	if (S_N_S(a) != NULL) copy(S_N_S(a),S_N_S(b));
	switch (S_O_K(a))
	{	
	case	SQ_RADICAL:
		copy(S_N_D(a),S_N_D(b));
		break;
	case	CYCLOTOMIC:
		S_N_DC(b)	= S_N_DC(a);
		break;
	default:
		return error("copy_number:invalid number type\n");
	}
	return(OK);
#endif /* NUMBERTRUE */
}

INT complex_conjugate(a,b) OP a,b;
{	
	OP	ptr;
	if (a != b)
		copy(a,b);
#ifdef NUMBERTRUE
	switch (S_O_K(b))
	{	
	case	SQ_RADICAL:
		ptr	= S_N_S(b);
		while (ptr != NULL)
		{	
			if (not EMPTYP(S_PO_K(ptr)))
				complex_conjugate(S_PO_K(ptr),S_PO_K(ptr));
			if (LT(S_PO_S(ptr),cons_null) == TRUE)
				addinvers_apply(S_PO_K(ptr));
			ptr	= S_L_N(ptr);
		}
		break;
	case	CYCLOTOMIC:
		ptr	= S_N_S(b);
		while (ptr != NULL)
		{	
			if (not EMPTYP(S_PO_K(ptr)))
			{	
				complex_conjugate(S_PO_K(ptr),S_PO_K(ptr));
				addinvers_apply(S_PO_S(ptr));
				add_apply(S_N_DCI(b),S_PO_S(ptr));
			}
			ptr	= S_L_N(ptr);
		}
		break;
	default:
		break;
	}
#endif /* NUMBERTRUE */
	return(OK);
}

INT setup_numbers(basis,saving,filename) INT basis, saving; 
char *filename;
/* 29.10.91: TPMcD */
{
#ifdef CYCLOTRUE
	number_mem = (INT)0;
#endif /* CYCLOTRUE */
#ifdef	MONOPOLYTRUE
	setup_prime_table();
#endif  /* MONOPOLYTRUE */
#ifdef	NUMBERTRUE
	basis_type		= basis;
	space_saving	= saving;
	setup_cyclotomic_table(filename);
#endif /* NUMBERTRUE */
	return(OK);
}

INT release_numbers()
/* 29.10.91: TPMcD */
{
#ifdef	MONOPOLYTRUE
	if (prime_table_set)
		SYM_free(prime_table);
#endif
#ifdef	NUMBERTRUE
	if (cyclo_table_set)
		{
		free_cyclo_table();
		SYM_free(zzcyclo_table);
		}
	if (cyclo_list_set)
		{
		free_cyclo_list();
		SYMfreeall(zzcyclo_list);
		}
#endif
	return(OK);
}

INT nb_ende()
{
#ifdef CYCLOTRUE
	if (number_mem != 0L)
		fprintf(stderr,"error in number memory %ld\n",number_mem);
#endif
}

INT reset_basis(basis) INT basis;
{
#ifdef	NUMBERTRUE
	basis_type	= basis;
	if (basis == NO_REDUCE || basis == POWER_REDUCE)
		printf("\nWARNING: not a valid basis\n");
#endif
	return(OK);
}

INT reset_saving(saving) INT saving;
{
#ifdef	NUMBERTRUE
	space_saving	= saving;
#endif
	return(OK);
}

INT tex_monom_plus(form,a) INT form; OP a;
/* AK 200891 V1.3 */
{	
	return tex_monom(a);/* AK return */
}

/*Multiplies the entries in two lists pairwise, putting the resulting	*/
/*objects in a list.  Duplicate objects are ignored.		*/

static INT mult_lists(a,b,c) OP a, b, c;
/* 26.08.90: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	INT	flag = 0L;
#ifdef	LISTTRUE
	OP	new, a_ptr, b_ptr, c_tmp;

	if (c == a || c == b)
	{	
		flag	= 1L;
		c_tmp	= callocobject();
	}
	else
		c_tmp	= c;
	init(SYMLIST, c_tmp);
	b_ptr = b;
	while (b_ptr != NULL)
	{	
		a_ptr = a;
		while (a_ptr != NULL)
		{	
			new	= callocobject();
			mult(S_L_S(a_ptr), S_L_S(b_ptr), new);
			insert(new,c_tmp,NULL,NULL);
			a_ptr = S_L_N(a_ptr);
		};
		b_ptr = S_L_N(b_ptr);
	}
	if (flag)
	{	
		copy(c_tmp,c);
		SYMfreeall(c_tmp);
	}
	return(OK);
#else
	error("mult_lists: SYMLIST not available");
	return(ERROR);
#endif
}

INT tidy(a) OP a;
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	i,j; 
	OP	ptr;
	switch (S_O_K(a))
	{
#ifdef BRUCHTRUE
	case BRUCH : 
		tidy(S_B_O(a)); 
		tidy(S_B_U(a)); 
		break;
#endif /* BRUCHTRUE */
	case INTEGER : 
		break;
#ifdef LISTTRUE
	case POLYNOM:
	case SYMLIST : 
		ptr = a;
		while (ptr != NULL)
		{	
			tidy(S_L_S(ptr));
			ptr	= S_L_N(ptr);
		}
		break;
#endif /* LISTTRUE */
#ifdef LONGINTTRUE
	case LONGINT : 
		break;
#endif /* LONGINTTRUE */
#ifdef MATRIXTRUE
	case MATRIX :
		for (i=0L;i<S_M_LI(a);i++)
			for (j=0L;j<S_M_HI(a);j++)
				tidy(S_M_IJ(a,i,j));
		break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
	case MONOM : 
		tidy(S_MO_S(a)); 
		tidy(S_MO_K(a)); 
		break;
#endif /* MONOMTRUE */
#ifdef NUMBERTRUE
	case SQ_RADICAL: 
		break;
	case CYCLOTOMIC: 
		standardise_cyclo_0(a,basis_type); 
		break;
#endif /* NUMBERTRUE */
#ifdef VECTORTRUE
	case VECTOR :
		for (i=0L;i<S_V_LI(a);i++)
			tidy(S_V_I(a,i));
		break;
#endif /* VECTORTRUE */
	default:
		return error("tidy: invalid type\n");
	}
	return(OK);
}
/******************		fields_1.c		**********************/
/* 26.07.91: TPMcD.										     */
/*************************************************************/

/*	MONOPOLYS	*/

#ifdef	MONOPOLYTRUE

INT eval_monopoly(a,b,c) OP a,b,c;
/*AK 290395 */
{
	INT erg = OK;
	OP z,d;
	if (check_equal_3(a,b,c,eval_monopoly,&erg) == EQUAL)
                goto ae;
	CTO(MONOPOLY,"eval_monopoly",a);
	erg += m_i_i((INT)0,c);
	z = a;
	d = callocobject();
	while (z != NULL)
		{
		CTO(INTEGER,"eval_monopoly:non integer self part",
				S_MO_S(S_L_S(z)));
		erg += hoch(b,S_MO_S(S_L_S(z)),d);
		erg += mult_apply(S_MO_K(S_L_S(z)),d);
		erg += add_apply(d,c);
		z = S_L_N(z);
		}
	erg += SYMfreeall(d);
ae:
	ENDR("eval_monopoly");
}

INT einsp_monopoly(a) OP a;
{
	if (S_L_S(a) == NULL)
		return FALSE;
	if (S_L_N(a) != NULL) 
		return FALSE;
	if (not nullp(S_MO_S(S_L_S(a))))
		return FALSE;
	if (not einsp(S_MO_K(S_L_S(a))))
                return FALSE;
	return TRUE;
}

INT m_skn_mp(s,k,n,e) OP s,k,n,e;
/* make self koeff next monopoly */
/* AK 040291 */ /* AK 200891 V1.3 */
{	
	INT erg=OK;
	if ( n == NULL) {
		erg += b_skn_mp(callocobject(),callocobject(),NULL,e);
		erg += copy(s,S_PO_S(e));
		erg += copy(k,S_PO_K(e));
	}
	else {
		erg += b_skn_mp(callocobject(),callocobject(),callocobject(),e);
		erg += copy(s,S_PO_S(e));
		erg += copy(k,S_PO_K(e));
		erg += copy(n,S_PO_N(e));
	}
	ENDR("m_skn_mp");
}



INT b_skn_mp(s,k,n,e) OP s,k,n,e;
/* build self koeff next monopoly */
/* AK 040291 */ /* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{
	INT erg=OK;
	COP("b_skn_mp",e);
	if (not EMPTYP(e))
		erg+=freeself(e);
	erg += b_sn_l(callocobject(),n,e);
	C_O_K(e,MONOPOLY);
	erg += b_sk_mo(s,k,S_L_S(e));
	ENDR("b_skn_mp");
}



INT scan_monopoly(a) OP a;
/* AK 200990 */ /* AK 220191 V1.2 */
/* a becomes a monopoly */ /* AK 200891 V1.3 */
{
	OBJECTKIND kt,st;
	INT erg = OK;
	erg += printeingabe("type of monopoly self ");
	st=scanobjectkind();
	erg += printeingabe("type of monopoly koeff ");
	kt=scanobjectkind();
	erg += SCMPCO(st,kt,a);
	ENDR("scan_monopoly");
}
#endif /* MONOPOLYTRUE */

static INT SCMPCO(self_type,coeff_type,result) /* scan_monopoly_co */
	OBJECTKIND self_type,coeff_type; 
OP result;
/* 04.06.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{	
	INT	ret = ERROR; 
	INT	i,n;
# ifdef	MONOPOLYTRUE
	OP	x = callocobject(), y = callocobject(), z;
	char a[30];

	init(MONOPOLY,result);
	printeingabe("Length of list: ");  /* AK 080891 */
	scanf("%ld",&n);
	for (i=0L;i<n;i++)
	{	
		sprintf(a,"%d-th monomial (self) ",i);
		printeingabe(a);
		scan(self_type,x);
		sprintf(a,"%d-th monomial (koeff) ",i);
		printeingabe(a);
		scan(coeff_type,y);
		if (nullp(y))
			continue;
		z = callocobject();
		m_sk_mo(x,y,z);
		insert(z,result,add_koeff,NULL);
	}
	if (empty_listp(result))
		insert_zero_into_monopoly(result);
	SYMfreeall(x); 
	SYMfreeall(y);
	ret	= OK;
#else
	error("SCMPCO: MONOPOLY not available");
#endif
	return(ret);
}

/*	Removes those terms from a MONOPOLY with zero coefficients unless	*/
/*	this makes the list empty. In this case, one term with self and		*/
/*	koeff both 0 is left.	*/

# ifdef	MONOPOLYTRUE
INT remove_zero_terms(a) OP a;
/* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
{
	OP	term, ptr = a, a_tmp = callocobject();
	INT erg = OK;

	CTO(MONOPOLY,"remove_zero_terms",a);
	erg += init(MONOPOLY,a_tmp);
	if (!empty_listp(ptr))
		while (ptr != NULL)
		{	
			if (not nullp(S_PO_K(ptr)))
			{	
				term = callocobject();
				erg += copy(S_L_S(ptr),term);
				insert(term,a_tmp,add_koeff,NULL);
			}
			ptr	= S_L_N(ptr);
		}
	if (empty_listp(a_tmp))
		insert_zero_into_monopoly(a_tmp);
	erg += copy(a_tmp,a);
	erg += SYMfreeall(a_tmp);
	ENDR("remove_zero_terms");
}
#endif /* MONOPOLYTRUE */

/*	This is used to convert an empty monopoly into a non-empty one	*/

# ifdef	MONOPOLYTRUE
static INT insert_zero_into_monopoly(a) OP a;
/* 1.04.91: TPMcD. */ /* AK 200891 V1.3 */
{
	OP  m = callocobject();
	b_sk_mo(callocobject(),callocobject(),m);
	M_I_I(0L,S_MO_K(m));
	M_I_I(0L,S_MO_S(m));
	insert(m,a,add_koeff,NULL);
	return(OK);
}
# endif /* MONOPOLYTRUE */

static INT integer_coefficients(a) OP a;
/* 25.09.91: TPMcD. */
{	
	OP	ptr = a;
# ifdef	MONOPOLYTRUE
	if (S_O_K(a) != MONOPOLY)
		error("integer_coefficients: parameter is not a MONOPOLY");
	if (!empty_listp(ptr))
		while (ptr != NULL)
		{	
			if (S_O_K(S_PO_K(ptr)) != INTEGER && S_O_K(S_PO_K(ptr)) != LONGINT)
				return(FALSE);
			ptr	= S_L_N(ptr);
		}
#else
	error("integer_coefficients: MONOPOLY not available");
#endif
	return(TRUE);
}

# ifdef	MONOPOLYTRUE
INT add_scalar_monopoly(a,b,c) OP a,b,c;
/* 30.05.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	OP	ptr;
	INT erg = OK;
	CTO(MONOPOLY,"add_scalar_monopoly",b);
	if (c == a)
		erg += ERROR;
	if (c != b)
		copy(b,c);
	ptr	= callocobject();
	erg += init(MONOPOLY,ptr);
	C_L_S(ptr,callocobject());
	erg += m_sk_mo(cons_null,a,S_L_S(ptr));
	erg += add_apply(ptr,c);
	erg += remove_zero_terms(c);
	erg += SYMfreeall(ptr);
	ENDR("add_scalar_monopoly");
}
#endif

INT mult_scalar_monopoly(a,b,c) OP a,b,c;
/* 30.05.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	flag = 0L;
	OP	c_tmp, ptr;
# ifdef	MONOPOLYTRUE
	if (c == a)
		return( error("First and third arguments equal\n") );
	ptr	= b;
	if (EMPTYP(S_PO_S(ptr)))
		ptr = S_L_N(ptr);
	if (c == b)
	{	
		c_tmp	= callocobject();
		flag	= 1L;
	}
	else
		c_tmp	= c;
	init(MONOPOLY,c_tmp);
	if (NEQ(a,cons_null) && ptr != NULL)
		trans2formlist(a,ptr,c_tmp,mult);
	if (flag)
	{	
		copy(c_tmp,c);
		SYMfreeall(c_tmp);
	}
	remove_zero_terms(c);
#endif
	return(OK);
}

# ifdef	MONOPOLYTRUE
INT add_monopoly_monopoly(a,b,c) OP a, b, c;
/* 30.05.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{
	OP temp_eins, temp_zwei;
	INT erg = OK;

	temp_eins = callocobject();	
	temp_zwei = callocobject();
	copy(a,temp_eins);
	copy(b,temp_zwei);
	init(S_O_K(a), c);
	insert(temp_eins,c,add_koeff,NULL);
	insert(temp_zwei,c,add_koeff,NULL);
	erg += remove_zero_terms(c);
	ENDR("add_monopoly_monopoly");
}


INT mult_monopoly_monopoly(a,b,c) OP a, b, c;
/* 30.05.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	flag = 0L;
	OP	new, a_ptr, b_ptr, c_tmp;
	OP	temp_eins, temp_zwei;
	INT erg = OK;
	if (c == a || c == b)
	{	
		flag	= 1L;
		c_tmp	= callocobject();
	}
	else
		c_tmp	= c;
	erg += init(MONOPOLY, c_tmp);

	if (S_L_S(b) == NULL) /* AK 191093 */
		goto mmm_ende;
	if (S_L_S(a) == NULL) /* AK 220596 */
		goto mmm_ende;

	b_ptr = b;
	if (EMPTYP(S_PO_S(b_ptr)))		/* skip the empty term */
		b_ptr = S_L_N(b_ptr);
	while (b_ptr != NULL)
	{	
		a_ptr = a;
		if (EMPTYP(S_PO_S(a_ptr)))		/* skip the empty term */
			a_ptr = S_L_N(a_ptr);
		while (a_ptr != NULL)
		{	
			temp_eins = callocobject();
			temp_zwei = callocobject();
			erg += add(S_PO_S(a_ptr), S_PO_S(b_ptr), temp_eins);
			erg += mult(S_PO_K(a_ptr), S_PO_K(b_ptr), temp_zwei);
			new	= callocobject();
			erg += b_sk_mo(temp_eins,temp_zwei,new);
			insert(new,c_tmp,add_koeff,NULL);
			a_ptr = S_L_N(a_ptr);
		}
		b_ptr = S_L_N(b_ptr);
	}
	if (flag)
	{	
		erg += copy(c_tmp,c);
		erg += SYMfreeall(c_tmp);
	}
	erg += remove_zero_terms(c);
mmm_ende: /* AK 191093 */
	/* AK inserted */ 
	ENDR("mult_monopoly_monopoly");
}
#endif /* MONOPOLYTRUE */

/*	This routine deals with MONOPOLYs which are effectively		*/
/*	LISTs of MONOMs whose coefficients are scalars and selfs	*/
/*	are non-negative integers -- they correspond to polynomials	*/
/*	in one variable. The quotient (qpoly) and remainder (rpoly)	*/
/*	of the division of poly by dpoly are calculated.  The		*/
/*	parameters poly,dpoly,qpoly and rpoly must all be different.*/

INT quores_monopoly(poly,dpoly,qpoly,rpoly) OP poly,dpoly,qpoly,rpoly;
/* 30.05.90: TPMcD. */ /* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT	ret	= ERROR;
# ifdef	MONOPOLYTRUE
	OP	term = NULL, temp, sz, ptr_a, coeff = callocobject(),
	    minus = callocobject(), ddeg = callocobject(), dlead = callocobject(),
	    rdeg = callocobject(), rlead = callocobject();

	if (S_O_K(poly) != MONOPOLY || S_O_K(dpoly) != MONOPOLY)
		goto exit_label;
	M_I_I(-1L,minus);

	/*	Find the leading term of dpoly	*/
	if (empty_listp(rpoly))
		error("quores_monopoly: divisor is zero");
	ptr_a = dpoly;
	while (ptr_a != NULL)
	{	
		sz = ptr_a;
		ptr_a = S_L_N(ptr_a);
	}
	copy(S_PO_S(sz),ddeg);
	copy(S_PO_K(sz),dlead);
	if (EQ(ddeg,cons_null) && EQ(dlead,cons_null))
		error("quores_monopoly: divisor is zero");
	addinvers(ddeg,ddeg);
	addinvers(dlead,dlead);
	copy(poly,rpoly);
	init(MONOPOLY,qpoly);
	ptr_a	= rpoly;
	while(ptr_a != NULL)
	{	/*  If the remainder is zero, break from the loop	*/
		if (empty_listp(rpoly))
		{	
			insert_zero_into_monopoly(rpoly);
			ret	= OK;
			break;
		}
		/*	Find the leading term of the current rpoly	*/
		while (ptr_a != NULL)
		{	
			sz = ptr_a;
			ptr_a = S_L_N(ptr_a);
		}
		copy(S_PO_S(sz),rdeg);
		copy(S_PO_K(sz),rlead);
		add(ddeg,rdeg,rdeg);
		/*	The remainder has degree less than the divisor	*/
		if (LT(rdeg,cons_null))
		{	
			ret	= OK;
			goto exit_label;
		}
		div3(rlead,dlead,coeff);
		temp	= callocobject();
		init(MONOPOLY,temp);
		term	= callocobject();
		m_sk_mo(rdeg,coeff,term);
		insert(term,temp,add_koeff,NULL);
		term	= callocobject();
		/* m_sk_mo(rdeg,coeff,term); */
		init(MONOPOLY,term);
		C_L_S(term,callocobject());
		m_sk_mo(rdeg,cons_eins,S_L_S(term));
		mult_apply(coeff,term);
		insert(term,qpoly,add_koeff,NULL);
		mult_monopoly_monopoly(temp,dpoly,temp);
		insert(temp,rpoly,add_koeff,NULL);
		ptr_a = rpoly;
	}
exit_label:
	remove_zero_terms(rpoly);
	if (empty_listp(qpoly))
		insert_zero_into_monopoly(qpoly);
	mult_scalar_monopoly(minus,qpoly,qpoly);
	remove_zero_terms(qpoly);
	SYMfreeall(coeff); /* AK 080891 */
	SYMfreeall(minus);
	SYMfreeall(ddeg); 
	SYMfreeall(rdeg); 
	SYMfreeall(dlead); 
	SYMfreeall(rlead);
#else
	error("quores_monopoly: MONOPOLY not available");
	ret	= ERROR;
#endif
	return(ret);
}

#ifdef	MONOPOLYTRUE
INT add_monopoly(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
{
	INT erg = OK;
	OP d;
	CTO(MONOPOLY,"add_monopoly",a);
	if (S_L_S(a) == NULL)
	{
		C_L_S(a,callocobject());
		erg += b_sk_mo(callocobject(),callocobject(),S_L_S(a));
		M_I_I(0L,S_PO_K(a));
		M_I_I(0L,S_PO_S(a));
	}
	switch(S_O_K(a))
	{
	case INTEGER:
	case LONGINT:
	case BRUCH: 
		erg += add_scalar_monopoly(a,b,c);
		goto ee;
	case MONOPOLY:
		switch(S_O_K(b))
		{
		case INTEGER:
		case LONGINT:
			erg += add_scalar_monopoly(b,a,c);
			goto ee;
		case BRUCH: 
			erg += add_bruch(b,a,c);
                        goto ee;

		case MONOPOLY: 
			erg += add_monopoly_monopoly(a,b,c);
			goto ee;
		case LAURENT:
			d = callocobject();
			erg += t_LAURENT_OBJ(b,d);
			erg += add(a,d,c);
			erg += SYMfreeall(d);
			goto ee;
		case POLYNOM:
                        d=callocobject();
                        erg += t_POLYNOM_MONOPOLY(b,d);
                        erg += add_monopoly_monopoly(a,d,c);
                        erg += SYMfreeall(d);
                        goto ee;

		default: 
			WTO("add_monopoly:second parameter",b);
			goto ee;
		}
	default: 
		WTO("add_monopoly:first parameter",a);
	}
ee:
	ENDR("add_monopoly");
}
#endif

#ifdef	MONOPOLYTRUE
INT mult_monopoly(a,b,c) OP a,b,c;
/* 24.07.91: TPMcD. */
/* AK 200891 V1.3 */
{
	OP d;
	INT erg = OK;
	CTO(MONOPOLY,"mult_monopoly",a);

	switch(S_O_K(b))
	{
	case BRUCH:
		if (scalarp(S_B_O(b)) && scalarp(S_B_U(b)))
			erg += mult_scalar_monopoly(b,a,c);
		else
			{
			erg += copy(b,c);
			erg += mult(a,S_B_O(b),S_B_O(c));
		 	erg += kuerzen(c);
			}
		goto ee;
	case INTEGER:
	case LONGINT:
		erg += mult_scalar_monopoly(b,a,c);
		goto ee;
	case MONOPOLY: 
		erg += mult_monopoly_monopoly(a,b,c);
		goto ee;
#ifdef MATRIXTRUE
	case MATRIX: 
		erg += mult_scalar_matrix(a,b,c);
		goto ee;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
	case MONOM: 
		erg += mult_scalar_monom(a,b,c);
		break;
#endif /* MONOMTRUE */
#ifdef LAURENTTRUE
	case LAURENT: 
		d = callocobject();
		erg += t_LAURENT_OBJ(b,d);
		erg += mult(a,d,c);
		erg += SYMfreeall(d);
		break;
#endif /* LAURENTTRUE */
#ifdef POLYTRUE
	case POLYNOM: 
		 if(has_one_variable(b)==TRUE)
                {
                        d=callocobject();
                        erg += t_POLYNOM_MONOPOLY(b,d);
                        erg += mult_monopoly_monopoly(a,d,c);
                        erg += SYMfreeall(d);
                   }    
		else
			erg += mult_scalar_polynom(a,b,c);
		break;
#endif /* POLYTRUE */
#ifdef SCHUBERTTRUE
	case SCHUBERT: erg +=  mult_scalar_schubert(a,b,c);
			break;
#endif /* SCHUBERTTRUE */
	case VECTOR: 
		 erg += mult_scalar_vector(a,b,c);
		break;
	default: 
		WTT("mult_monopoly",a,b);
	}

ee:
	ENDR("mult_monopoly");
}
#endif /* MONOPOLYTRUE */

#ifdef	MONOPOLYTRUE
INT addinvers_monopoly(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	OP	minus;
	if (S_O_K(a) != MONOPOLY)
		return(ERROR);
	minus = callocobject();
	M_I_I(-1L,minus);
	mult_scalar_monopoly(minus,a,b);
	SYMfreeall(minus);
	return(OK);
}


INT add_apply_monopoly(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	INT	erg = OK;
	OP	c = callocobject();
	erg +=  add(a,b,c);
	erg += copy(c,b);
	erg += SYMfreeall(c);
	ENDR("add_apply_monopoly");
}


INT mult_apply_monopoly(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	INT	erg = OK;
	OP	c = callocobject();
	erg += mult_monopoly(a,b,c);
	erg += copy(c,b);
	erg += SYMfreeall(c);
	ENDR("mult_apply_monopoly");
}

INT addinvers_apply_monopoly(a) OP a;
/* AK 200891 V1.3 */
{
	return(addinvers_monopoly(a,a));
}
#endif /* MONOPOLYTRUE */

INT nullp_monopoly(a) OP a;
/* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
{
# ifdef	MONOPOLYTRUE
	OP ptr = a;
	if (EMPTYP(a) || S_O_K(a) != MONOPOLY)
		error("nullp_monopoly");
	if (empty_listp(a))
		return(TRUE);
	if (EMPTYP(S_L_S(ptr)))
		ptr = S_L_N(ptr);
	if (ptr == NULL || empty_listp(ptr))
		return(TRUE);
	if (S_L_N(ptr) != NULL)
		return(FALSE);
	if (EQ(S_PO_S(ptr),cons_null) && EQ(S_PO_K(ptr),cons_null))
		return(TRUE);
#endif
	return(FALSE);
}

INT comp_monopoly(a,b) OP a,b;
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
# ifdef	MONOPOLYTRUE
	return(comp_list(a,b));
#else
	return(ERROR);
#endif
}

INT raise_power_monopoly(a,b) OP a, b;
/* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
{	
	OP	ptr;
# ifdef	MONOPOLYTRUE
	ptr	= b;
	if (EMPTYP(S_PO_S(ptr)))
		ptr	= S_L_N(ptr);
	while (ptr != NULL)
	{	
		mult(a,S_PO_S(ptr),S_PO_S(ptr));
		ptr	= S_L_N(ptr);
	}
#endif
	return(OK);
}

INT scale_monopoly(a,b) OP a, b;
/* MD */
/* AK 200891 V1.3 */
{	
	OP	ptr;
# ifdef	MONOPOLYTRUE
	OP	factor = callocobject(), minus = callocobject();
	M_I_I(-1L,minus);
	ptr	= b;
	if (EMPTYP(S_PO_S(ptr)))
		ptr	= S_L_N(ptr);
	if (EQ(a,minus) == TRUE)
		while (ptr != NULL)
		{	
			mod(S_PO_S(ptr),cons_zwei,factor);
			if (EQ(factor,cons_eins) == TRUE)
				mult(minus,S_PO_K(ptr),S_PO_K(ptr));
			ptr	= S_L_N(ptr);
		}
	else
		while (ptr != NULL)
		{	
			hoch(a,S_PO_S(ptr),factor);
			mult(factor,S_PO_K(ptr),S_PO_K(ptr));
			ptr	= S_L_N(ptr);
		}
	SYMfreeall(factor); 
	SYMfreeall(minus);
#endif
	return(OK);
}

INT objectread_monopoly(f,a) FILE *f; OP a;
/* 4.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
# ifdef	MONOPOLYTRUE
	objectread_list(f,a);
	C_O_K(a,MONOPOLY);
#endif
	return(OK);
}

# ifdef	MONOPOLYTRUE
INT tex_monopoly(a) OP a;
/* 2.04.91: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	INT first = 1L;
	OP	ptr = a;
	fprintf(texout," ");
	while (ptr != NULL)
	{	
		if (!negp(S_PO_K(ptr)) && !first)
			fprintf(texout," + {");
		else
			fprintf(texout,"{");
		tex(S_PO_K(ptr));
		fprintf(texout,"} x {");
		tex(S_PO_S(ptr));
		fprintf(texout,"}\n");
		ptr	= S_L_N(ptr);
		first = 0L;
		texposition += 6;
	}
	fprintf(texout,"\n");
	texposition = 0;
	return(OK);
}

/*	CONSTRUCTION OF SPECIAL TYPES OF MONOPOLY	*/

/*	Given the number n, which should be an positive INTEGER or LONGINT,*/
/*	the result returns the polynomial x**n-1.			*/

INT m_iindex_monopoly(ii,mon) INT ii; OP mon;
{
	INT erg = OK;
	COP("m_iindex_monopoly",mon);
	erg += b_skn_mp(callocobject(),callocobject(),NULL,mon);
	erg += m_i_i(ii,S_PO_S(mon));
	erg += m_i_i(1L,S_PO_K(mon));
	ENDR("m_iindex_monopoly");
}

INT make_unitary0_monopoly(number,result) OP number, result;
/* 10.06.90: TPMcD. */ /* AK 200891 V1.3 */
{	
	OP	new;
	OP	exp = callocobject(), coeff = callocobject();
	init(MONOPOLY,result);
	M_I_I(0L,exp); /* we use the macro, beacuse exp is empty */
	M_I_I(-1L,coeff);
	new = callocobject();
	m_sk_mo(exp,coeff,new);
	insert(new,result,add_koeff,NULL);
	m_i_i(1L,coeff);
	new = callocobject();
	m_sk_mo(number,coeff,new);
	insert(new,result,add_koeff,NULL);
	SYMfreeall(exp); 
	SYMfreeall(coeff);
	return(OK);
}
#endif /* MONOPOLYTRUE */

/*	Given the number n, which should be an positive INTEGER or LONGINT,*/
/*	the result returns the MONOPOLY x**(n-1)+x**(n-2)+...+x+1.	*/

INT make_unitary_eins_monopoly(number,result) OP number, result;
/* 10.06.90: TPMcD. */ /* AK 200891 V1.3 */
{	
	OP	new, ptr;
# ifdef	MONOPOLYTRUE
	OP	exp = callocobject(), coeff = callocobject();
	init(MONOPOLY,result);
	ptr	= result;
	M_I_I(0L,exp);
	M_I_I(1L,coeff);
	while (LT(exp,number) == TRUE)
	{	
		new = callocobject();
		init(MONOPOLY,new);
		S_L_S(new) = callocobject();
		m_sk_mo(exp,coeff,S_L_S(new));
		insert(new,result,NULL,NULL);
		inc(exp);
	}
	SYMfreeall(exp); 
	SYMfreeall(coeff);
	return(OK);
#else
	return(ERROR);
#endif
}

/*	Given the number n, which should be an positive INTEGER or LONGINT*/
/*	or a MONOPOLY representing a prime factorisation of an integer greater*/
/*	than 1 , the result returns the cyclotomic polynomial of index n.*/

INT make_cyclotomic_monopoly(number,result) OP number, result;
/* 100690: TPMcD. */ /* AK 200891 V1.3 */
{	
	INT	flag = 1L;
	INT	ret = ERROR;
	OP	ptr;
# ifdef	MONOPOLYTRUE
	OP	minus, exp, factor, poly_eins, poly_zwei, poly_drei,
	    list = callocobject();

	if (S_O_K(number) == MONOPOLY)
		copy(number,list);
	else
	{	
		if (S_O_K(number) != INTEGER && S_O_K(number) != LONGINT
		    || LT(number,cons_eins) == TRUE)
			goto exit_label;

		if (einsp(number))
		{	
			make_unitary0_monopoly(number,result);
			ret	= OK;
			goto exit_label;
		}
		integer_factor(number,list);
	}
	ptr	= list;
	if (EMPTYP(S_PO_S(ptr)))
		ptr	= S_L_N(ptr);
	factor = callocobject();
	copy(S_PO_S(ptr),factor);

	if (S_L_N(ptr) == NULL)	/* list has just one prime factor */ 
	{	
		make_unitary_eins_monopoly(factor,result);
		dec(S_PO_K(ptr));
		exp = callocobject();
		integer_factors_to_integer(ptr,exp);
		raise_power_monopoly(exp,result);
		SYMfreeall(exp);
		ret	= OK;
		SYMfreeall(factor); /* AK 060993 */
		goto exit_label;
	}
	else
	{	
		poly_eins = callocobject();
		ptr	= S_L_N(ptr);
		make_cyclotomic_monopoly(ptr,poly_eins);
		if (EQ(factor,cons_zwei) == TRUE)
		{	
			minus	= callocobject();
			M_I_I(-1L,minus);
			scale_monopoly(minus,poly_eins);
			copy(poly_eins,result);
			SYMfreeall(minus);
		}
		else
		{	
			poly_zwei = callocobject(); 
			poly_drei = callocobject();
			copy(poly_eins,poly_zwei);
			raise_power_monopoly(factor,poly_eins);
			quores_monopoly(poly_eins,poly_zwei,result,poly_drei);
			SYMfreeall(poly_zwei); 
			SYMfreeall(poly_drei);
		}
		SYMfreeall(poly_eins);
		ret	= OK;
	}
	ptr	= list;
	if (EMPTYP(S_PO_S(ptr)))
		/* ptr	= S_L_N(ptr); */
		error("nb internal error 234");
	dec(S_PO_K(ptr));
	ptr     = S_L_N(ptr);
	while (ptr != NULL)
	{	
		/* dec(S_PO_K(ptr)); */
		m_i_i(0L,S_PO_K(ptr));
		ptr	= S_L_N(ptr);
	}
	integer_factors_to_integer(list,factor);
	raise_power_monopoly(factor,result);
	SYMfreeall(factor);
exit_label:
	SYMfreeall(list);
#endif
	return(ret);
}
/******************		fields_2.c		**********************/
/* 26.07.91: TPMcD.										     */
/*************************************************************/

/*	SQUARE RADICALS		*/

#ifdef	SQRADTRUE
INT make_monopoly_sqrad(a,b) OP a,b;
/* 30.05.90: TPMcD. */ /* 3.04.91: TPMcD. */
/* AK 200891 V1.3 */
{	
	INT	flag = 0L;
	OP	ptr, new, b_tmp, sqfree = callocobject(), sqpart = callocobject();
	if (b == a)
	{	
		flag	= 1L;
		b_tmp	= callocobject();
	}
	else
	{	
		init(SQ_RADICAL,b);
		b_tmp	= S_N_S(b);
	}
	init(MONOPOLY, b_tmp);
	ptr = a;
	while (ptr != NULL)
	{	
		if (not nullp(S_PO_S(ptr)))  /* AK 120891 */
		{	
			square_free_part(S_PO_S(ptr),sqfree,
			    sqpart,NULL,NULL,NULL);
			mult(S_PO_K(ptr),sqpart,sqpart);
			new 	= callocobject();
			m_sk_mo(sqfree,sqpart,new);
			insert(new,b_tmp,add_koeff,
			    comp_monomvector_monomvector);
		}
		ptr = S_L_N(ptr);
	}
	if (flag)
	{	
		init(SQ_RADICAL,b);
		SYMfreeall(S_N_S(b)); /* AK 060993 */
		S_N_S(b)	=  b_tmp;
	}
	remove_zero_terms(S_N_S(b));
	find_sqrad_data(b);
	SYMfreeall(sqfree); 
	SYMfreeall(sqpart);
	return(OK);
}
#endif /* SQRADTRUE */
/*	a: the scalar; b: the result.	*/

#ifdef	SQRADTRUE
INT make_scalar_sqrad(a,b) OP a,b;
/* 5.04.91: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	OP c;
	INT erg = OK;
	c	= callocobject();
	erg += b_skn_mp(callocobject(),callocobject(),NULL,c);
	erg += copy(a,S_PO_K(c));
	M_I_I(1L,S_PO_S(c));
	erg += make_monopoly_sqrad(c,b);
	if (not EMPTYP(S_N_D(b)))
		erg += freeself(S_N_D(b));
	erg += find_sqrad_data(b);
	erg += SYMfreeall(c);
	ENDR("make_scalar_sqrad");
}
#endif

#ifdef SQRADTRUE
INT scan_sqrad(a) OP a;
/* AK 300191 V1.2 */ /* a becomes sqrad */
/* 3.04.91: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{
	OP c = callocobject();
	INT erg=OK;
	erg += printeingabe("self of sqrad");
	erg += scan(MONOPOLY,c);
	erg += make_monopoly_sqrad(c,a);
	erg += find_sqrad_data(a);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* SQRADTRUE */

#ifdef SQRADTRUE
INT add_scalar_sqrad(a,b,c) OP a,b,c;
/* 30.05.90: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	OP	ptr;
	INT erg = OK;
	if (S_O_K(b) != SQ_RADICAL)
	{	
		error("add_scalar_sqrad: Second argument not SQ_RADICAL");
		return(ERROR);
	}
	if (c == a)
	{	
		error("add_scalar_sqrad: First and third arguments equal");
		return(ERROR);
	}
	if (c != b) copy(b,c);
	ptr	= callocobject();
	erg += init(MONOPOLY,ptr);
	C_L_S(ptr,callocobject());
	erg += m_sk_mo(cons_eins,a,S_L_S(ptr));
	erg += add(ptr,S_N_S(c),S_N_S(c));
	erg += SYMfreeall(ptr);
	if (space_saving)
		convert_sqrad_scalar(c);
	return erg;
}
#endif /* SQRADTRUE */

#ifdef	SQRADTRUE
INT mult_scalar_sqrad(a,b,c) OP a, b, c;
/* 30.05.90: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	OP	ptr;
	INT erg = OK;
	CTO(SQ_RADICAL,"mult_scalar_sqrad",b);

	if (b == a || c == a)
	{	
	erg += error("mult_scalar_sqrad:first argument same as second or third\n");
	goto endr_ende;
	}
	if (space_saving && nullp(a))
	{	
		erg += copy(a,c);
		goto endr_ende;
	}
	if (c != b)
		copy(b,c);
	ptr = S_N_S(c);
	if (EMPTYP(S_PO_S(ptr)))
		ptr = S_L_N(ptr);
	while (ptr != NULL)
	{	

		mult(S_PO_K(ptr),a,S_PO_K(ptr));
		ptr = S_L_N(ptr);
	}
	remove_zero_terms(S_N_S(c));
	if (nullp_sqrad(c))
		find_sqrad_data(c);

	ENDR("mult_sqrad_sqrad");
}

INT add_sqrad_sqrad(a,b,c) OP a, b, c;
/* 23.06.90: TPMcD. */ /* 3.04.91: TPMcD. */
/* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	INT	flag = 0L;
	INT erg = OK;
	OP	c_tmp, data_a = callocobject(), data_b = callocobject();
	if (S_O_K(a) != SQ_RADICAL || S_O_K(b) != SQ_RADICAL)
	{	
		WTT("add_sqrad_sqrad",a,b);
		goto endr_ende;
	}
	find_sqrad_data(a);
	find_sqrad_data(b);
	copy(S_N_D(a),data_a);
	copy(S_N_D(b),data_b);
	if (!empty_listp(data_b))
		insert(data_b,data_a,NULL,NULL);
	else
		SYMfreeall(data_b);
	if (c == a || c == b)
	{	
		flag	= 1L;
		c_tmp	= callocobject();
	}
	else
	{	
		init(SQ_RADICAL,c);
		c_tmp	= S_N_S(c);
	}
	erg += init(MONOPOLY,c_tmp);
	erg += add_monopoly_monopoly(S_N_S(a),S_N_S(b),c_tmp);
	if (flag)
	{	
		if (not EMPTYP(S_N_S(c)))
			erg += SYMfreeall(S_N_S(c));
		S_N_S(c)	= c_tmp;
	}
	if (not EMPTYP(S_N_D(c)))
		erg += SYMfreeall(S_N_D(c));
	S_N_D(c)	= data_a;
	adjust_sqrad_data(c);
	ENDR("add_sqrad_sqrad");
}

#endif /* SQRADTRUE */
INT mult_sqrad_sqrad(a,b,c) OP a, b, c;
/* 30.05.90: TPMcD. */ /* 3.04.91: TPMcD. */
/* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{	
	INT	flag = 0L;
#ifdef	SQRADTRUE
	OP	a_ptr, b_ptr, c_tmp, new;
	OP	temp_eins, temp_zwei, temp_drei, data_a, data_b;
	if (S_O_K(a) != SQ_RADICAL || S_O_K(b) != SQ_RADICAL)
	{	
		error("mult_sqrad_sqrad: First or second argument not SQ_RADICAL");
		return(ERROR);
	}
	find_sqrad_data(a);
	find_sqrad_data(b);
	data_a = callocobject(); 
	data_b = callocobject();
	copy(S_N_D(a),data_a); 
	copy(S_N_D(b),data_b);
	if (!empty_listp(data_b))
		insert(data_b,data_a,NULL,NULL);
	else
		SYMfreeall(data_b);
	if (c == a || c == b)
	{	
		flag	= 1L;
		c_tmp	= callocobject();
	}
	else
	{	
		init(SQ_RADICAL,c);
		c_tmp	= S_N_S(c);
	}
	init(MONOPOLY,c_tmp);
	b_ptr = S_N_S(b);
	if (EMPTYP(S_PO_S(b_ptr)))		/* skip the empty term */
		b_ptr = S_L_N(b_ptr);
	temp_eins = callocobject(); 
	temp_zwei = callocobject(); 
	temp_drei = callocobject();
	while (b_ptr != NULL)
	{
		if (not nullp(S_PO_S(b_ptr))) /* AK 120891 */
		{
			a_ptr = S_N_S(a);
			while (a_ptr != NULL)
			{
				if (not nullp(S_PO_S(a_ptr))) /* AK 120891 */
				{
				ggt(S_PO_S(a_ptr), S_PO_S(b_ptr), temp_eins);
				nb_ganzdiv(S_PO_S(a_ptr), temp_eins, temp_zwei);
				nb_ganzdiv(S_PO_S(b_ptr), temp_eins, temp_drei);
				mult_apply(S_PO_K(a_ptr),temp_eins);
				mult_apply(S_PO_K(b_ptr),temp_eins);
				mult_apply(temp_drei,temp_zwei);
				new	= callocobject();
				m_sk_mo(temp_zwei,temp_eins,new);
				insert(new,c_tmp,add_koeff,NULL);
				}
				a_ptr = S_L_N(a_ptr);
			}
		}
		b_ptr = S_L_N(b_ptr);
	}
	if (empty_listp(c_tmp))
		insert_zero_into_monopoly(c_tmp);
	if (flag)
	{	
		init(SQ_RADICAL,c);
		SYMfreeall(S_N_S(c)); /* AK 060993 */
		S_N_S(c)	= c_tmp;
	}
	if (not EMPTYP(S_N_D(c)))
		SYMfreeall(S_N_D(c));
	S_N_D(c)	= data_a;
	adjust_sqrad_data(c);
	SYMfreeall(temp_eins); 
	SYMfreeall(temp_zwei); 
	SYMfreeall(temp_drei);
	return(OK);
#else
	error("mult_sqrad_sqrad: SQ_RADICAL not available");
	return(ERROR);
#endif
}

INT add_sqrad(a,b,c) OP a,b,c;
/* AK 070891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT erg = OK;
	if (S_O_K(a) != SQ_RADICAL)
		return WTO("add_sqrad",a);
#ifdef	SQRADTRUE
	switch(S_O_K(b))
	{
	case CYCLOTOMIC: /* SQ + CYC = CYC */
		erg += add_cyclo(b,a,c); 
		break;
	case INTEGER:
	case LONGINT:
	case BRUCH: 
		erg += add_scalar_sqrad(b,a,c);
		break;
	case POLYNOM:
		erg += add_scalar_polynom(a,b,c);
		break;
	case SQ_RADICAL:
		erg += add_sqrad_sqrad(a,b,c);
		break;
	default:
		erg += error("add_sqrad: wrong second type\n");
	};
	if (space_saving)
		convert_sqrad_scalar(c);
#endif
	return erg;
}

INT mult_sqrad(a,b,c) OP a,b,c;
/* AK 200291 V1.2 */ /* 24.07.91: TPMcD. */
/* typ a ist SQ_RADICAL */
/* AK 130891 V1.3 */
/* 04.10.91: TPMcD */
{	
	INT erg = OK;
#ifdef	SQRADTRUE
	switch(S_O_K(b))
	{
	case INTEGER:
	case LONGINT:
	case CYCLOTOMIC:
	case BRUCH: 
		erg += mult_scalar_sqrad(b,a,c); 
		break;
#ifdef MATRIXTRUE
	case MATRIX: 
		erg += mult_scalar_matrix(a,b,c); 
		break;
#endif /* MATRIXTRUE */
#ifdef MONOMTRUE
	case MONOM: /* AK 200291 */
		erg += mult_scalar_monom(a,b,c); 
		break;
#endif /* MONOMTRUE */
	case VECTOR: 
		erg += mult_scalar_vector(a,b,c); 
		break;
	case SQ_RADICAL: 
		erg += mult_sqrad_sqrad(a,b,c); 
		break;
#ifdef POLYTRUE
	case POLYNOM: /* AK 200291 */
		erg +=  mult_scalar_polynom(a,b,c); 
		break;
#endif /* POLYTRUE */
#ifdef SCHUBERTTRUE
	case SCHUBERT: /* AK 200291 */
		erg +=  mult_scalar_schubert(a,b,c); 
		break;
#endif /* SCHUBERTTRUE */
	default:
		printobjectkind(b);
		erg += error("mult_sqrad: wrong second type\n");
		break;
	}
	if (space_saving)
		convert_sqrad_scalar(c);
	if (erg != OK)
		error("mult_sqrad: error during computation");
#endif
	return erg;
}

#ifdef	MONOPOLYTRUE
INT addinvers_sqrad(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	OP	minus;
	if (S_O_K(a) != SQ_RADICAL)
		return error("addinvers_sqrad:object not sqrad");
	find_sqrad_data(a);
	minus = callocobject();
	M_I_I(-1L,minus);
	mult_scalar_sqrad(minus,a,b);
	SYMfreeall(minus);
	return(OK);
}
#endif /* MONOPOLYTRUE */

#ifdef	SQRADTRUE
INT invers_sqrad(a,b) OP a,b;
/* 23.06.90: TPMcD. */ /* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{	
	INT	ret = OK;
	INT	flag = 0L;
	OP	b_tmp, y_tmp, new, ptr,  prime, minus, x_tmp = callocobject(),
	    data_length = callocobject(), mono_length = callocobject();
	OP ax1;

	if (S_O_K(a) != SQ_RADICAL)
	{	
		ret	+= invers(a,b);	/*	try the general routine	*/
		goto exit_label;
	}
	ret += find_sqrad_data(a);
	if (nullp_sqrad(a))
		error("invers_sqrad: 0 has no inverse\n");
	if (b == a)
	{	
		b_tmp	= callocobject();
		flag	= 1L;
	}
	else
		b_tmp	= b;
	ret += init(SQ_RADICAL,b_tmp);
	ret += init(MONOPOLY,S_N_S(b_tmp));
	ret += length(S_N_D(a),data_length);
	ret += length(S_N_S(a),mono_length);
	if (nullp(data_length))	/*	No radicals	*/
	{	
		ptr	= S_N_S(a);
		ret += invers(S_PO_K(ptr),x_tmp);
		new	= callocobject();
		ret += m_sk_mo(cons_eins,x_tmp,new);
		insert_list(new,S_N_S(b_tmp),NULL,NULL);
		goto exit_label;
	}
	else if (einsp(mono_length))	/*	One radical	*/
	{	
		ptr	= S_N_S(a);
		mult(S_PO_S(ptr),S_PO_K(ptr),x_tmp);
		invers(x_tmp,x_tmp);
		new	= callocobject();
		m_sk_mo(S_PO_S(ptr),x_tmp,new);
		insert_list(new,S_N_S(b_tmp),NULL,NULL);
		ret	= OK;
		goto exit_label;
	}
	/*	more than one radical	*/
	/*	the conjugate is built up in b_tmp	*/

	y_tmp	= callocobject();
	copy(a,x_tmp);
	make_scalar_sqrad(cons_eins,b_tmp);
	ptr	= S_N_D(a);
	while (ptr != NULL)
	{	
		prime		= S_L_S(ptr);
		if (S_O_K(x_tmp) != SQ_RADICAL)
			make_scalar_sqrad(x_tmp,x_tmp);
		conj_sqrad(x_tmp,prime,y_tmp);
		if (comp_sqrad(x_tmp,y_tmp) != 0L)
		{	
			mult_sqrad_sqrad(x_tmp,y_tmp,x_tmp);
			mult_sqrad_sqrad(b_tmp,y_tmp,b_tmp);
		}
		ptr	= S_L_N(ptr);
	}
	/*	at this point x_tmp should be scalar	*/
	if (convert_sqrad_scalar(x_tmp) == ERROR)
	{	
		SYMfreeall(y_tmp);
		error("invers_sqrad: the norm is not a scalar\n");
		goto exit_label;
	}
	if (negp(x_tmp))
	{	
		ret +=  mult_scalar_sqrad(cons_negeins,b_tmp,b_tmp);
		ret += addinvers_apply(x_tmp);
	}
#ifdef UNDEF
#endif
	ret += invers(x_tmp,y_tmp);
	ret += mult_scalar_sqrad(y_tmp,b_tmp,b_tmp);

	ret += SYMfreeall(y_tmp);
exit_label:
	if (flag)
	{	
		copy(b_tmp,b);
		SYMfreeall(b_tmp);
	}
	SYMfreeall(x_tmp); 
	SYMfreeall(data_length); 
	SYMfreeall(mono_length);
	return(ret);
}
#endif /* SQRADTRUE */

#ifdef SQRADTRUE
INT add_apply_sqrad(a,b) OP a,b;
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{	
	INT	erg=OK;
	OP	c = callocobject();
	erg += add_sqrad(a,b,c);
	erg += copy(c,b);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* SQRADTRUE */

INT mult_apply_sqrad(a,b) OP a,b;
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{	
	INT	ret = ERROR;
#ifdef SQRADTRUE
	OP	c = callocobject();
	ret	= mult_sqrad(a,b,c);
	copy(c,b);
	SYMfreeall(c);
#endif /* SQRADTRUE */
	return(ret);
}

#ifdef SQRADTRUE
INT addinvers_apply_sqrad(a) OP a;
/* AK 200891 V1.3 */
{
	return(addinvers_sqrad(a,a));
}
#endif /* SQRADTRUE */

#ifdef	SQRADTRUE
INT nullp_sqrad(a) OP a;
/* 1.04.91: TPMcD. */
/* AK 200891 V1.3 */
{
	OP ptr = S_N_S(a);
	if (nullp_monopoly(ptr))
		return(TRUE);
	return(FALSE);
}
#endif /* SQRADTRUE */

INT comp_sqrad(a,b) OP a,b;
/* AK 200891 V1.3 */
{
#ifdef SQRADTRUE
	return(comp_list(S_N_S(a),S_N_S(b)));
#endif /* SQRADTRUE */
}

# ifdef	SQRADTRUE
static INT fprint_sqrad(f,a) FILE *f; 
OP a;
/* 25.09.91: TPMcD. */
{	
	INT first = 1L, rational = 0L;
	OP	ptr;
	ptr = S_N_S(a);
	zeilenposition	+= 4L;
	if (nullp_sqrad(a))
	{	
		fprintf(f," 0");
		return(OK);
	}
	while (ptr != NULL)
	{       
		if (zeilenposition > 60L)
		{       
			zeilenposition  = 0L;
			fprintf(f,"\n");
		}
		if (einsp(S_PO_S(ptr)))
			rational	= 1L;	/* A rational term	*/
		else
			rational	= 0L;
		/*	print the coefficient part of a term	*/
		if (!negp(S_PO_K(ptr)) && !first)
			fprintf(f," +");
		if (negeinsp(S_PO_K(ptr)))
		{	
			if (rational)
				fprintf(f," - 1");
			else
				fprintf(f," -");
		}
		else if (einsp(S_PO_K(ptr)))
		{	
			if (rational)
				fprintf(f," 1");
		}
		else
		{
			fprintf(f," ");
			fprint(f,S_PO_K(ptr));
		}

		if (not rational)		/*	print the radical part of a term	*/
		{	
			fprintf(f," sqr(");
			fprint(f,S_PO_S(ptr));
			fprintf(f,")");
			zeilenposition	+= 6L;
		}
		ptr	= S_L_N(ptr);
		first = 0L;
	}
	return(OK);
}
#endif /* SQRADTRUE */

INT tex_sqrad(a) OP a;
/* 020491: TPMcD. */
/* AK 200891 V1.3 */
/* 041091: TPMcD */
{	
	INT first = 1L;
# ifdef	SQRADTRUE
	OP	ptr = S_N_S(a);
	find_sqrad_data(a);
	if (nullp_sqrad(a))
	{	
		fprintf(texout," 0\n");
		return(OK);
	}
	fprintf(texout," ");
	while (ptr != NULL)
	{	
		if (!negp(S_PO_K(ptr)) && !first)
			fprintf(texout," + {");
		else
			fprintf(texout,"{");
		tex(S_PO_K(ptr));
		if (NEQ(S_PO_S(ptr),cons_eins))
		{	
			fprintf(texout,"} \\sqrt{");
			tex(S_PO_S(ptr));
		}
		fprintf(texout,"}");
		ptr	= S_L_N(ptr);
		first = 0L;
	}
	fprintf(texout," ");
	return(OK);
#else
	error("tex_sqrad: SQ_RADICAL not available");
	return(ERROR);
#endif
}

static INT find_sqrad_data(a) OP a;
/* 23.06.90: TPMcD. */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{
#ifdef	SQRADTRUE
	OP	new, num, next_num, ptr, next_ptr, data_ptr, list_ptr,
	    list_copy = callocobject(),	prime_list = callocobject(),
	    quo = callocobject(), rem = callocobject();

	if (S_N_D(a) == NULL)
		S_N_D(a)	= callocobject();
	data_ptr	= S_N_D(a);
	/*	Assume the data is OK if it is a non-empty SYMLIST	*/
	if (not EMPTYP(data_ptr) && S_O_K(data_ptr) == SYMLIST
	    && not empty_listp(data_ptr))
		{
		goto fsd_ende;
		}
	init(SYMLIST,data_ptr);
	copy(S_N_S(a),list_copy);
	ptr	= list_copy;
	num	= S_PO_S(ptr);
	if (LT(num,cons_null) == TRUE)	/*	negative radicals	*/
	{	
		new	= callocobject();
		M_I_I(-1L,new);
		insert_list(new,data_ptr,NULL,NULL);
		while (ptr != NULL)	/*multiply negative radicals by -1*/
		{	
			num	= S_PO_S(ptr);
			if (LT(num,cons_null) == TRUE)
				addinvers_apply(num);
			else
				break;
			ptr	= S_L_N(ptr);
		}
	}
	ptr	= list_copy;
	while (ptr != NULL)
	{	
		num	= S_PO_S(ptr);
		if (not einsp(num) && not nullp(num))
		{	
			integer_factor(num,prime_list);
			list_ptr	= prime_list;
			while (list_ptr != NULL)
			{	
				new	= callocobject();
				copy(S_PO_S(list_ptr),new);/* new is the next prime	*/
				next_ptr	= S_L_N(ptr);
				while (next_ptr != NULL)
				{	
					next_num	= S_PO_S(next_ptr);
					if (NEQ(next_num,cons_eins) == TRUE)
					{	
						nb_quores(next_num,new,quo,rem);
						if (nullp(rem)) /* AK 120891 */
							copy(quo,next_num);
					}
					next_ptr	= S_L_N(next_ptr);
				}
				insert_list(new,data_ptr,NULL,NULL);
				list_ptr	= S_L_N(list_ptr);
			}
			freeself(prime_list);
		}
		ptr	= S_L_N(ptr);
	}
fsd_ende:
	SYMfreeall(list_copy); 
	SYMfreeall(prime_list); 
	SYMfreeall(rem); 
	SYMfreeall(quo);
	return(OK);
#else
	error("find_sqrad_data: SQ_RADICAL not available");
	return(ERROR);
#endif
}

/*	a: the sqrad */

static INT adjust_sqrad_data(a) OP a;
/* 15.04.91: TPMcD. */
/* AK 200891 V1.3 */
{	
	INT	inserted = 1L;
#ifdef	SQRADTRUE
	OP	new, quo, rem, ptr, data_ptr, a_copy, prime_list, num_ptr;
	if (S_O_K(a) != SQ_RADICAL)
		return(ERROR);
	if (S_N_D(a) == NULL || EMPTYP(S_N_D(a)))
		return(find_sqrad_data(a));
	if (empty_listp(S_N_D(a)))
		return(OK);
	prime_list	= callocobject();
	init(SYMLIST,prime_list);
	a_copy	= callocobject();
	copy(a,a_copy);
	ptr	= S_N_S(a_copy);
	num_ptr	= S_PO_S(ptr);
	if (LT(num_ptr,cons_null) == TRUE)	/*negative radicals	*/
	{	
		new	= callocobject();
		M_I_I(-1L,new);
		insert_list(new,prime_list,NULL,NULL);
		while (ptr != NULL)/*multiply negative radicals by -1	*/
		{	
			num_ptr	= S_PO_S(ptr);
			if (LT(num_ptr,cons_null) == TRUE)
				addinvers_apply(num_ptr);
			else
				break;
			ptr	= S_L_N(ptr);
		}
	}
	data_ptr	= S_N_D(a);
	quo = callocobject();
	rem = callocobject();
	while (data_ptr != NULL)
	{
	if (negeinsp(S_L_S(data_ptr))) /* negatives have been taken care of*/
		{	
			data_ptr	= S_L_N(data_ptr);
			continue;
		}
		if (inserted)
			new	= callocobject();
		copy(S_L_S(data_ptr),new);	/* new is the next prime*/
		inserted	= 0L;
		ptr	= S_N_S(a_copy);
		while (ptr != NULL)
		{	
			num_ptr	= S_PO_S(ptr);
			if (einsp(num_ptr) || nullp(num_ptr))
			{	
				ptr	= S_L_N(ptr);
				continue;
			}
			nb_quores(num_ptr,new,quo,rem);
			if (nullp(rem))
			{	
				copy(quo,num_ptr);
				if (not inserted)
				{	
					insert(new,prime_list,NULL,NULL);
					inserted	= 1L;
				}
			}
			ptr	= S_L_N(ptr);
		}
		data_ptr	= S_L_N(data_ptr);
	}
	if (not inserted)
		freeself(new);
	else
		new	= callocobject();
	make_monopoly_sqrad(S_N_S(a_copy),new);	/* reconstitute the sqrad */
	if (convert_sqrad_scalar(new) == ERROR)
	{
		freeself(S_N_D(a));
		SYMfreeall(prime_list);
		find_sqrad_data(a);
	}
	else
	{	
		SYMfreeall(S_N_D(a));
		S_N_D(a)	= prime_list;
	}
	SYMfreeall(quo); 
	SYMfreeall(rem); 
	SYMfreeall(new); 
	SYMfreeall(a_copy);
	return(OK);
#else
	error("adjust_sqrad_data: SQ_RADICAL not available");
	return(ERROR);
#endif
}

/*	a: the sqrad; b: the radical; c: the conjugate	*/

INT conj_sqrad(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{	
	OP	la, lb, rem, minus, ptr, new;
#ifdef	SQRADTRUE

	if (not EMPTYP(c))  /* AK 060993 */
		freeself(c);

	la = callocobject(); 
	lb = callocobject();
	rem = callocobject(); 
	minus = callocobject();
	M_I_I(-1L,minus);
	init(MONOPOLY,la);
	init(MONOPOLY,lb);
	ptr	= S_N_S(a);
	if (EQ(b,minus) == TRUE)
		while (ptr != NULL)
		{	
			new	= callocobject();
			copy(S_L_S(ptr),new);
			if (LT(S_MO_S(new),cons_null) == TRUE)
				insert_list(new,lb,NULL,NULL);
			else
				insert_list(new,la,NULL,NULL);
			ptr	= S_L_N(ptr);
		}
	else
		while (ptr != NULL)
		{	
			new	= callocobject();
			copy(S_L_S(ptr),new);
			mod(S_MO_S(new),b,rem);
			if (nullp(rem)) /* AK 120891 */
				insert_list(new,lb,NULL,NULL);
			else
				insert_list(new,la,NULL,NULL);
			ptr	= S_L_N(ptr);
		}
	if (empty_listp(lb))
		insert_zero_into_monopoly(lb);
	mult_scalar_monopoly(minus,lb,lb);
	insert(lb,la,NULL,NULL);
	if (c == a)
		SYMfreeall(S_N_S(a));
	else
		{	
			init(SQ_RADICAL,c);
			copy(S_N_D(a),S_N_D(c));
		}
	remove_zero_terms(la);
	if (S_N_S(c) != NULL)
		{
		SYMfreeall(S_N_S(c)); /* AK 060993 */
		}
	S_N_S(c)	= la;
	SYMfreeall(rem);	
	SYMfreeall(minus);
	return(OK);
#else /* SQRADTRUE */
	error("conj_sqrad: SQ_RADICAL not available");
	return(ERROR);
#endif /* SQRADTRUE */
}

#ifdef SQRADTRUE
INT squareroot_integer(a,b) OP a,b;
/* AK 040291 V1.2 */ /* AK 200891 V1.3 */
{
	INT erg = OK;
	OP c;
	if ((S_O_K(a) != INTEGER)
		&&
		(S_O_K(a) != LONGINT))
		return ERROR;
	c = callocobject();
	erg += b_skn_mp(callocobject(),callocobject(),NULL,c);
	erg += M_I_I(1L,S_PO_K(c));
	erg += copy(a,S_PO_S(c));
	erg += make_monopoly_sqrad(c,b);
	erg += SYMfreeall(c);
	return erg;
}
#endif /* SQRADTRUE */

#ifdef	SQRADTRUE
INT squareroot_longint(a,b) OP a,b;
/* AK 040291 V1.2 */ /* AK 200891 V1.3 */
{
	return squareroot_integer(a,b);
}
#endif /* SQRADTRUE */

#ifdef	SQRADTRUE
INT squareroot_bruch(a,b) OP a,b;
/* AK 040291 V1.2 */ /* AK 200891 V1.3 */ /* 04.10.91: TPMcD */
{
	INT erg=OK;
	OP  c,d;
	if (S_O_K(a) != BRUCH)
		return ERROR;
	c = callocobject(); 
	d = callocobject();
	erg += mult(S_B_O(a),S_B_U(a),c);
	/*
	erg += invers(S_B_U(a),d);
	erg += init(SQ_RADICAL,b);
	erg	+= b_skn_mp(c,d,NULL,S_N_S(b));
	*/ /* error  3/4 ---> sqr(12) * 1/4 */
	erg += squareroot(c,b);
	erg += invers(S_B_U(a),d);
	erg += mult_apply(d,b);
	erg += SYMfreeall(c);
	erg += SYMfreeall(d);
	return erg;
}
#endif /* SQRADTRUE */

#ifdef	SQRADTRUE
INT convert_sqrad_scalar(a) OP a;
/* 5.04.91: TPMcD. */ /* AK 200891 V1.3 */
{	
	INT	ret = ERROR;
	OP tmp;
	if (S_O_K(a) != SQ_RADICAL || S_L_N(S_N_S(a)) != NULL)
		return(ret);
	tmp	= S_PO_S(S_N_S(a));
	if (not einsp(tmp) && not nullp(tmp))
		return(ret);
	ret	= OK;
	if (nullp(tmp))
	{	
		m_i_i(0L,a);
		return(ret);
	}
	tmp	= callocobject();
	copy(S_PO_K(S_N_S(a)),tmp);
	copy(tmp,a);
	SYMfreeall(tmp);
	return OK;
}
#endif /* SQRADTRUE */

/*	Convert the square root of an integer a to a cyclotomic number	*/

INT convert_radical_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */ /* 29.10.91: TPMcD */
{	
	INT	even, posi, last = 1L;
	OP	new, ptr, mono_ptr;
	INT	ret = ERROR;
# ifdef NUMBERTRUE
	OP	k = callocobject(), m = callocobject(), mpos = callocobject(),
	    x = callocobject(), y = callocobject(), z = callocobject(),
	    w = callocobject(), atmp, four = callocobject();
	if (S_O_K(a) != INTEGER && S_O_K(a) != LONGINT)
		goto exit_label;
	if (not negp(a) && square_root(a,k) == OK)
	{	
		make_scalar_cyclo(k,b);
		goto exit_label;
	}
	if (a == b)
	{	
		atmp	= callocobject();
		copy(a,atmp);
	}
	else
		atmp	= a;
	init(CYCLOTOMIC,b);
	mono_ptr	= callocobject();
	init(MONOPOLY,mono_ptr);
	S_N_S(b)	= callocobject();
	M_I_I(4L,four);
	integer_factor_1(atmp,cons_zwei,cons_zwei,m,y,NULL);
	/*	a = 4k * 2l * m
	 *  l=0 ,m=1(4): return 2k * r(m)
	 *	l=0 ,m=3(4): return 2(k-1) * r(4*m)
	 *	l=1			return 2(k-1) * r(8*m)
	 */
	ptr	= y;
	if (empty_listp(ptr))	/*	a > 0 and a is odd	*/
	{	
		even	= 0L;
		posi	= 1L;
	}
	else if (EQ(S_PO_S(ptr),cons_zwei))	/*	a > 0 and a is even	*/
	{	
		even	= 1L;
		posi	= 1L;
	}
	else
	{	
		ptr	= S_L_N(ptr);
		if (ptr == NULL)	/*	a < 0 and a is odd	*/
		{	
			even	= 0L;
			posi	= 0L;
		}
		else
		{	
			even	= 1L;
			posi	= 0L;
		}
	}
	if (!posi)
		addinvers_apply(m);
	if (even)
	{	
		nb_quores(S_PO_K(ptr),cons_zwei,k,z);
		if (nullp(z)) /* AK 120891 */	/*	a = 4k * m	*/
		last = 0L;
		hoch(cons_zwei,k,w);			/*	w = 2k	*/
	}
	else
	{	
		copy(cons_eins,w);
		last = 0L;
	}
	if (!last)
	{	
		mod(m,four,z);
		if (!einsp(z))
		{	
			div3(w,cons_zwei,w);
			mult(m,four,m);
		}
	}
	else
	{	
		div3(w,cons_zwei,w);
		mult(m,four,m);
		mult(m,cons_zwei,m);
	}
	copy(m,mpos);
	if (negp(mpos))
		addinvers_apply(mpos);
	make_coprimes(mpos,y);
	ptr	= y;
	while (ptr != NULL)
	{	
		if (kronecker(m,S_L_S(ptr),z) == OK)
		{	
			new	= callocobject();
			m_sk_mo(S_L_S(ptr),z,new);
			insert(new,mono_ptr,add_koeff,NULL);
		}
		ptr	= S_L_N(ptr);
	}
	remove_zero_terms(mono_ptr);
	make_index_monopoly_cyclo(mpos,mono_ptr,b,0L);
	mult_scalar_cyclo(w,b,b);
	if (a == b)
		SYMfreeall(atmp);
	ret	= OK;
exit_label:
	SYMfreeall(k); 
	SYMfreeall(m); 
	SYMfreeall(mpos); 
	SYMfreeall(x); 
	SYMfreeall(y); 
	SYMfreeall(z);
	SYMfreeall(w); 
	SYMfreeall(four);
# endif
	return(ret);
}

# ifdef NUMBERTRUE
INT convert_sqrad_cyclo(a,b) OP a,b;
/* 29.10.91: TPMcD */
{	
	OP	atmp, c, ptr;
	if (S_O_K(a) != SQ_RADICAL)
		return(ERROR);
	if (a == b)
	{	
		atmp	= callocobject();
		copy(a,atmp);
	}
	else
		atmp	= a;
	if (not EMPTYP(b))
		freeself(b);
	m_i_i(0L,b);
	c	= callocobject();
	ptr	= S_N_S(atmp);
	while (ptr != NULL)
	{	
		convert_radical_cyclo(S_PO_S(ptr),c);
		mult_apply(S_PO_K(ptr),c);
		add(b,c,b);
		ptr	= S_L_N(ptr);
	}
	if (a == b)
		SYMfreeall(atmp);
	SYMfreeall(c);
	return(OK);
}
#endif /* NUMBERTRUE */

/******************		fields_3.c		**********************/
/* 26.07.91: TPMcD.										     */
/*************************************************************/

/*	CYCLOTOMIC	*/

/*	a : the index, b : the monopoly, c : the result	*/

INT trans_index_monopoly_cyclo(a,b,c) OP a,b,c;
/* AK 300791 for compatibility */
/* AK 200891 V1.3 */
{
	return make_index_monopoly_cyclo(a,b,c,POWER_REDUCE);
}

static INT make_index_monopoly_cyclo(a,b,c,tid) OP a,b,c; INT tid;
/* 30.05.90: TPMcD. */ /* 3.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{	
	OP	c_tmp;
#ifdef	CYCLOTRUE
	INT	flag = 0L;
	CYCLO_DATA	*c_ptr = NULL;

	if (S_O_K(b) != MONOPOLY)
		error("make_index_monopoly_cyclo: 2nd parameter is wrong type\n");
	if ((c_ptr = add_cyclo_data(a)) == NULL)
		error("make_index_monopoly_cyclo: unable to create cyclotomic data\n");
	if (c == b)
	{	
		flag	= 1L;
		c_tmp	= callocobject();
	}
	else
	{	
		init(CYCLOTOMIC,c);
		c_tmp	= S_N_S(c);
	}
	init(MONOPOLY, c_tmp);
	if (empty_listp(c_tmp))
		insert_zero_into_monopoly(c_tmp);
	copy(b, c_tmp);
	if (flag)
	{	
		init(CYCLOTOMIC,c);
		S_N_S(c)	= c_tmp;
	}
	S_N_DC(c)	= c_ptr;
	if (tid != NO_REDUCE)
		standardise_cyclo_0(c,tid);
	return(OK);
#else
	error("make_index_monopoly_cyclo: CYCLOTOMIC not available");
	return(ERROR);
#endif
}

INT standardise_cyclo(a) OP a;
/* 25.10.91: TPMcD */
{
	return(standardise_cyclo_0(a,basis_type));
}

static INT standardise_cyclo_0(a,tid) OP a; 
INT tid;
/* 09.09.90: TPMcD. */ /* 4.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 25.10.91: TPMcD */
{	
	INT	erg, ret = ERROR;
#ifdef	CYCLOTRUE
	CYCLO_DATA	*c_ptr;
	OP	ptr, new, mono, exp, poly_eins, poly_zwei;

	if (S_O_K(a) != CYCLOTOMIC || tid == NO_REDUCE)
		return(OK);
	ptr		= S_N_S(a);
	c_ptr	= S_N_DC(a);
	mono	= callocobject();
	init(MONOPOLY,mono);
	exp	= callocobject();
	if ( not empty_listp(ptr))
		while (ptr != NULL)
		{	
			erg =  mod(S_PO_S(ptr),c_ptr->index,exp);
			if (erg == ERROR)
				return error("standardise_cyclo_0: mod");
			new 	= callocobject();
			m_sk_mo(exp,S_PO_K(ptr),new);
			insert(new,mono,add_koeff,NULL);
			ptr = S_L_N(ptr);
		}
	SYMfreeall(exp);
	if (empty_listp(mono))
		insert_zero_into_monopoly(mono);
	switch((int)tid)
	{	
	case (int)POWER_REDUCE:
		poly_zwei	= mono;
		break;
	case (int)STD_BASIS:
		poly_eins	= callocobject();
		poly_zwei	= callocobject();
		quores_monopoly(mono,c_ptr->poly,poly_eins,poly_zwei);
		SYMfreeall(mono); 
		SYMfreeall(poly_eins);
		break;
	default:
		return error("standardise_cyclo_0: unknown cyclotomic basis");
		break;
	}
	SYMfreeall(S_N_S(a));
	S_N_S(a)	= poly_zwei;
	ret	= OK;
#else
	error("standardise_cyclo_0: CYCLOTOMIC not available");
#endif
	return(ret);
}

#ifdef	CYCLOTRUE
INT make_scalar_cyclo(a,b) OP a,b;
/* 5.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
	OP c = callocobject(); 
	OP d = callocobject();
	M_I_I(1L,c);
	b_skn_mp(callocobject(),callocobject(),NULL,d);
	copy(a,S_PO_K(d));
	M_I_I(0L,S_PO_S(d));
	make_index_monopoly_cyclo(c,d,b,NO_REDUCE);
	SYMfreeall(c); 
	SYMfreeall(d);
	return(OK);
}
#endif /* CYCLOTRUE */

#ifdef	CYCLOTRUE
INT make_index_coeff_power_cyclo(a,b,c,d) OP a,b,c,d;
/* 30.05.90: TPMcD. */ /* 17.07.91: TPMcD. */
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{
	init(CYCLOTOMIC,d);
	b_skn_mp(callocobject(),callocobject(),NULL,S_N_S(d));
	mod(c,a,S_PO_S(S_N_S(d)));
	copy(b,S_PO_K(S_N_S(d)));

	if (S_N_DC(d) != NULL)
		error("internal error:MIC1");

	S_N_DC(d)	= add_cyclo_data(a);

	if (space_saving)
		convert_cyclo_scalar(d);

	return(OK);
}
#endif /* CYCLOTRUE */

#ifdef	CYCLOTRUE
INT scan_cyclo(a) OP a;
/* AK 240191 V1.2 */ /* a becomes cyclotomic */
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{
	OP b = callocobject(); 
	OP c = callocobject();
	INT erg = OK;
	erg += printeingabe("degree of cyclotomic field");
	erg += scan(INTEGER,b);
	erg += printeingabe("self of cyclotomic field");
	erg += scan(MONOPOLY,c);
	erg += make_index_monopoly_cyclo(b,c,a,basis_type);
	erg += SYMfreeall(b); 
	erg += SYMfreeall(c);
	return erg;
}
#endif /* CYCLOTRUE */

/*	a: the scalar, b: the cyclo, c: the result	*/

INT add_scalar_cyclo(a,b,c) OP a,b,c;
/* 30.05.90: TPMcD. */ /* AK 080891 V1.3 */ /* 23.10.91: TPMcD */
{	
	OP	ptr; 
	INT erg = OK;
#ifdef	CYCLOTRUE
	if (c == a)
		error("First and third arguments equal\n");
	if (c != b)
		copy(b,c);
	ptr	= callocobject();
	erg += init(MONOPOLY,ptr);
	C_L_S(ptr,callocobject());
	erg += m_sk_mo(cons_null,a,S_L_S(ptr));
	erg += add_apply(ptr,S_N_S(c));
	erg += SYMfreeall(ptr);
	if (space_saving)
		convert_cyclo_scalar(c);
#endif /* CYCLOTRUE */
	return erg;
}

/*	a: the scalar, b: the cyclo, c: the result */

INT mult_scalar_cyclo(a,b,c) OP a, b, c;
/* 06.09.90: TPMcD. */ /* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{	
	INT	flag = 0L; 
	OP	c_tmp;
#ifdef	CYCLOTRUE
	if (c == a || b == a)
		error("mult_scalar_cyclo: First argument equals second or third\n");
	if (c == b)
	{	
		c_tmp	= callocobject();
		flag	= 1L;
	}
	else
	{	
		if (not EMPTYP(c))
			freeself(c);
		c_tmp	= c;
	}
	init(CYCLOTOMIC,c_tmp);
	mult_scalar_monopoly(a,S_N_S(b),S_N_S(c_tmp));
	if (flag)
	{	
		S_N_DC(c_tmp)	= S_N_DC(b);
		copy(c_tmp,c);
		SYMfreeall(c_tmp);
	}
	else
		S_N_DC(c)	= S_N_DC(b);
	if (space_saving)
		convert_cyclo_scalar(c);
#endif
	return(OK);
}

/*	a,b: the cyclos, c: the result	*/

INT add_cyclo_cyclo(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
	return( add_cyclo_cyclo_0(a,b,c,basis_type) );
}

static INT add_cyclo_cyclo_0(a,b,c,tid) OP a,b,c; INT tid;
/* 06.09.90: TPMcD. */ /* 5.04.91: TPMcD. */
/* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{
#ifdef	CYCLOTRUE
	OP	temp_eins, temp_zwei, temp_drei, temp_vier;

	if (S_O_K(a) != CYCLOTOMIC || S_O_K(b) != CYCLOTOMIC)
		return( error ("add_cyclo_cyclo_0: argument not CYCLOTOMIC") );
	temp_eins = callocobject();	
	temp_zwei = callocobject();
	temp_drei = callocobject();	
	temp_vier = callocobject();
	copy(S_N_S(a),temp_eins);
	copy(S_N_S(b),temp_zwei);
	ggt(S_N_DCI(a),S_N_DCI(b),temp_drei);
	nb_ganzdiv(S_N_DCI(a),temp_drei,temp_vier);
	raise_power_monopoly(temp_vier,temp_zwei);
	nb_ganzdiv(S_N_DCI(b),temp_drei,temp_vier);
	raise_power_monopoly(temp_vier,temp_eins);
	mult(S_N_DCI(a),temp_vier,temp_vier);
	init(CYCLOTOMIC, c);
	add_monopoly_monopoly(temp_eins,temp_zwei,S_N_S(c));
	S_N_DC(c)	= add_cyclo_data(temp_vier);
	if (tid != NO_REDUCE)
		standardise_cyclo_0(c,tid);
	if (space_saving)
		convert_cyclo_scalar(c);
	SYMfreeall(temp_eins); 
	SYMfreeall(temp_zwei); 
	SYMfreeall(temp_drei); 
	SYMfreeall(temp_vier);
	return(OK);
#else
	error("add_cyclo_cyclo: CYCLOTOMIC not available");
	return(ERROR);
#endif
}

INT mult_cyclo_cyclo(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
{	
	INT	erg = OK;
	erg += mult_cyclo_cyclo_0(a,b,c,basis_type); /* AK return inserted */
	return(erg);
}

static INT mult_cyclo_cyclo_0(a,b,c,tid) OP a,b,c; INT tid;
/* 06.09.90: TPMcD. */ /* 5.04.91: TPMcD. */
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
#ifdef	CYCLOTRUE
	OP	temp_eins, temp_zwei, temp_drei, temp_vier;

	if (S_O_K(a) != CYCLOTOMIC || S_O_K(b) != CYCLOTOMIC)
		return( error("mult_cyclo_cyclo_0: argument not CYCLOTOMIC") );
	if ( (nullp(a) || nullp(b)) && space_saving )
	{	
		m_i_i(0L,c);
		return(OK);
	}
	temp_eins = callocobject();	
	temp_zwei = callocobject();
	temp_drei = callocobject();	
	temp_vier = callocobject();
	copy(S_N_S(a),temp_eins);
	copy(S_N_S(b),temp_zwei);
	ggt(S_N_DCI(a),S_N_DCI(b),temp_drei);
	nb_ganzdiv(S_N_DCI(a),temp_drei,temp_vier);
	raise_power_monopoly(temp_vier,temp_zwei);
	nb_ganzdiv(S_N_DCI(b),temp_drei,temp_vier);
	raise_power_monopoly(temp_vier,temp_eins);
	mult(S_N_DCI(a),temp_vier,temp_vier);
	init(CYCLOTOMIC, c);
	mult_monopoly_monopoly(temp_eins,temp_zwei,S_N_S(c));
	if ((S_N_DC(c) = add_cyclo_data(temp_vier)) == NULL)
		error("Unable to find cyclotomic data\n");
	if (tid != NO_REDUCE)
		standardise_cyclo_0(c,tid);
	if (space_saving)
		convert_cyclo_scalar(c);
	SYMfreeall(temp_eins); 
	SYMfreeall(temp_zwei);
	SYMfreeall(temp_drei); 
	SYMfreeall(temp_vier);
	return(OK);
#else
	error("mult_cyclo_cyclo: CYCLOTOMIC not available");
	return(ERROR);
#endif
}

INT add_cyclo(a,b,c) OP a,b,c;
/* AK 070891 V1.3 */
{	
	INT erg = OK;
#ifdef	CYCLOTRUE
	switch(S_O_K(b))
	{	
	case INTEGER:
	case LONGINT:
	case SQ_RADICAL:
	case BRUCH:  
		erg += add_scalar_cyclo(b,a,c);
		break;
	case CYCLOTOMIC:  
		erg += add_cyclo_cyclo(a,b,c);
		break;
	case POLYNOM: 
		erg += add_scalar_polynom(a,b,c);
		break;
	default:
		printobjectkind(b);
		erg += error("add_cyclo: wrong second type\n");
		break;
	}
	convert_cyclo_scalar(c);
#endif
	return erg;
}

INT mult_cyclo(a,b,c) OP a,b,c;
/* 24.07.91: TPMcD. */
/* AK 200891 V1.3 */
{	
	INT erg = OK;
#ifdef	CYCLOTRUE
	/* S_O_K(a) == CYCLOTOMIC */
	if (nullp(a)){
		erg += m_i_i(0L,c);
		return(erg);
	}
	if (nullp(b)){
		erg += m_i_i(0L,c);
		return(erg);
	}
	switch(S_O_K(b))
	{
	case INTEGER:
	case SQ_RADICAL: /* AK 220891 */
	case LONGINT:
	case BRUCH: 
		erg += mult_scalar_cyclo(b,a,c);
		break;
#ifdef MATRIXTRUE
	case MATRIX: 
		erg += mult_scalar_matrix(a,b,c);
		break;
#endif /* MATRIXTRUE */
#ifdef POLYTRUE
	case SCHUR:
	case POW_SYM:
	case HOM_SYM:
	case ELM_SYM:
	case MONOMIAL:
	case POLYNOM: 
		erg += mult_scalar_polynom(a,b,c);
		break;
#endif /* POLYTRUE */
#ifdef SCHUBERTTRUE
	case SCHUBERT: 
		erg +=  mult_scalar_schubert(a,b,c);
		break;
#endif /* SCHUBERTTRUE */
	case VECTOR: 
		erg += mult_scalar_vector(a,b,c);
		break;
	case CYCLOTOMIC: 
		erg += mult_cyclo_cyclo(a,b,c);
		break;
	default:
		printobjectkind(b);
		erg += error("mult_cyclo: wrong second type\n");
		break;
	}
	if (erg != OK)
	{
		return error("mult_cyclo:error during computation");
	}
	convert_cyclo_scalar(c);
#endif
	return erg;
}

INT addinvers_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	OP	minus;
#ifdef	CYCLOTRUE
	if (S_O_K(a) != CYCLOTOMIC)
		return(ERROR);
	minus = callocobject();
	M_I_I(-1L,minus);
	mult_scalar_cyclo(minus,a,b);
	SYMfreeall(minus);
#endif
	return(OK);
}

/* a: the cyclo, b: the auto, c: the conjugate	*/

INT conj_cyclo(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
/* 23.10.91: TPMcD */
{
# ifdef	CYCLOTRUE
	if (S_O_K(a) != CYCLOTOMIC)
		return(ERROR);
	if (c != a)
		copy(a,c);
	raise_power_monopoly(b,S_N_S(c));
	standardise_cyclo_0(c,basis_type);
# endif
	return(OK);
}

/*	a: the cyclo, b: the inverse	*/

INT invers_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	INT	ret = ERROR;
# ifdef	CYCLOTRUE
	OP	c = callocobject();
	ret	= invers_cyclo_norm(a,b,c);
	SYMfreeall(c);
# endif
	return(ret);
}

/*	a: the cyclo, b: the inverse, c: the norm	*/

static INT invers_cyclo_norm(a,b,c) OP a,b,c;
/* AK 200891 V1.3 */
{	
	INT	flag = 0L, saving = space_saving;
# ifdef	CYCLOTRUE
	OP	ptr, tmp, b_tmp, minus;
	if (S_O_K(a) != CYCLOTOMIC)
		return(ERROR);
	if (nullp_cyclo(a))
		return(error("invers_cyclo_norm: cannot invert 0\n"));
	if (c == a || c == b)
		return(error("invers_cyclo_norm: illegal 3rd parameter\n"));
	if (b == a)
	{	
		b_tmp	= callocobject();
		flag	= 1L;
	}
	else
	{	
		if (not EMPTYP(b)) /* AK */
			freeself(b);
		b_tmp	= b;
	}
	space_saving	= FALSE;
	tmp	= callocobject();
	/*
	M_I_I(1L,tmp);
	*/
	make_scalar_cyclo(cons_eins,b_tmp);
	ptr	= S_N_DC(a)->autos;
	ptr	= S_L_N(ptr);	/*	Skip the trivial automorphism	*/
	while (ptr != NULL)
	{	
		conj_cyclo(a,S_L_S(ptr),tmp);
		mult_cyclo_cyclo_0(tmp,b_tmp,b_tmp,POWER_REDUCE);
		ptr	= S_L_N(ptr);
	}
	mult_cyclo_cyclo_0(a,b_tmp,tmp,basis_type);
	if (convert_cyclo_scalar(tmp) == ERROR)
	{	
		SYMfreeall(tmp);
		if (flag)
			SYMfreeall(b_tmp);
		return(error("invers_cyclo_norm: norm is not scalar\n"));
	}
	copy(tmp,c);
	if (negp(tmp))
	{	
		minus	= callocobject();
		m_i_i(-1L,minus);
		mult_scalar_sqrad(minus,b_tmp,b_tmp);
		addinvers_apply(tmp);
		SYMfreeall(minus);
	}
	invers(tmp,tmp);
	mult_scalar_cyclo(tmp,b_tmp,b_tmp);
	if (flag)
	{	
		copy(b_tmp,b);
		SYMfreeall(b_tmp);
	}
	SYMfreeall(tmp);
	space_saving	= saving;
# endif
	return(OK);
}

INT add_apply_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	INT	ret;
#ifdef	CYCLOTRUE
	OP	c = callocobject();
	ret	= add_cyclo(a,b,c);
	copy(c,b);
	SYMfreeall(c);
#endif
	return(ret);
}

INT mult_apply_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */
{	
	INT	ret;
#ifdef	CYCLOTRUE
	OP	c = callocobject();
	ret	= mult_cyclo(a,b,c);
	copy(c,b);
	SYMfreeall(c);
#endif
	return(ret);
}

INT addinvers_apply_cyclo(a) OP a;
/* AK 200891 V1.3 */
{
#ifdef	CYCLOTRUE
	return(addinvers_cyclo(a,a));
#else
	return(ERROR);
#endif
}

INT nullp_cyclo(a) OP a;
/* AK 200891 V1.3 */
{
#ifdef	CYCLOTRUE
	if (S_O_K(a) != CYCLOTOMIC)
		return(ERROR);
	if (EMPTYP(S_N_S(a)))
	{	
		error("nullp_cyclo: cyclo with empty self\n");
		return(TRUE);
	}
	return(nullp_monopoly(S_N_S(a)));
#else
	return(ERROR);
#endif
}
#ifdef CYCLOTRUE
INT comp_cyclo(a,b) OP a,b;
/* AK 200891 V1.3 */
{
	return(comp_list(S_N_S(a),S_N_S(b)));
}
#endif /* CYCLOTRUE */


# ifdef	CYCLOTRUE
INT convert_cyclo_scalar(a) OP a;
/* 5.04.91: TPMcD. */
/* AK 200891 V1.3 */
{	
	INT	ret = ERROR;
	OP tmp;

	if (S_O_K(a) != CYCLOTOMIC || S_L_N(S_N_S(a)) != NULL)
		goto exit_label;
	tmp	= S_PO_S(S_N_S(a));
	if (not nullp(tmp))
		goto exit_label;
	tmp	= callocobject();
	copy(S_PO_K(S_N_S(a)),tmp);
	copy(tmp,a);
	SYMfreeall(tmp);
	ret	= OK;
exit_label:
	return(ret);
}
#endif /* CYCLOTRUE */

#ifdef	CYCLOTRUE
static INT fprint_cyclo(f,a) FILE *f; 
OP a;
/* 25.09.91: TPMcD. */
{	
	INT first = 1L, flag;
	OP	ptr;

	standardise_cyclo_0(a,basis_type);
	ptr = S_N_S(a);
	zeilenposition	+= 2L;
	if (nullp_cyclo(a))
	{	
		fprintf(f," 0");
		return(OK);
	}
	while (ptr != NULL)
	{	
		flag	= 0L;
		if (zeilenposition > 60L)
		{       
			zeilenposition  = 0L;
			fprintf(f,"\n");
		}
		if (!negp(S_PO_K(ptr)) && !first)
			fprintf(f," +");
		if (negeinsp(S_PO_K(ptr)))
		{	
			flag	= 1L;
			fprintf(f," -");
		}
		else if (!einsp(S_PO_K(ptr)))
		{
			fprintf(f," ");
			fprint(f,S_PO_K(ptr));
		}
		else
		{
			fprintf(f," ");
			flag	= 1L;
		}

		if (not nullp(S_PO_S(ptr)))
		{	
			fprintf(f," E(");
			fprint(f,S_N_DCI(a));
			fprintf(f,")");
			if (!einsp(S_PO_S(ptr)))
			{
				fprintf(f," ");
				fprint(f,S_PO_S(ptr));
			}
			zeilenposition	+= 5L;
		}
		else if (flag)
			fprintf(f," 1");
		ptr	= S_L_N(ptr);
		first = 0L;
	}
	return(OK);
}
#endif /* CYCLOTRUE */

#ifdef	CYCLOTRUE
INT tex_cyclo(a) OP a;
/* 4.04.91: TPMcD. */ /* AK 200891 V1.3 */ /* 23.10.91: TPMcD */
{
	INT first = 1L;
	OP	ptr = S_N_S(a);

	if (nullp_cyclo(a))
	{	
		fprintf(texout," 0\n");
		return(OK);
	}
	fprintf(texout,"\n");
	while (ptr != NULL)
	{	
		if (!negp(S_PO_K(ptr)) && !first)
			fprintf(texout," + {");
		else
			fprintf(texout,"{");
		tex(S_PO_K(ptr));

		if (not nullp(S_PO_S(ptr)))
		{	
			fprintf(texout,"} \\omega_{");
			tex(S_N_DCI(a));
			fprintf(texout,"} {");
			tex(S_PO_S(ptr));
		}
		fprintf(texout,"}\n");
		ptr	= S_L_N(ptr);
		first = 0L;
	}
	fprintf(texout,"\n");
	return(OK);
}
#endif /* CYCLOTRUE */

/*	ROUTINES RELATING TO THE MAINTENANCE OF CYCLOTOMIC DATA	*/

# ifdef	CYCLOTRUE

/*Reads the table of cyclos from the file CYCLOS.DAT. The first entry	*/
/*should be no_cyclos, then the list of cyclo_data.  Returns OK if the	*/
/*table is set; otherwise, returns ERROR.		*/

static INT setup_cyclotomic_table(filename) char *filename;
/* 30.08.90: TPMcD */ /* AK 200891 V1.3 */
{	
	INT	i; 
	FILE	*f;
	CYCLO_DATA	*ptr;
	char	name[50], *char_ptr;

	if (cyclo_table_set || filename == NULL)
		return(OK);
	if ((f = fopen(filename,"r")) == NULL)
	{	
		printf("\nFile containing cyclo data: ");
		char_ptr	= name;
		while( (*char_ptr = fgetc(stdin)) != '\n')
		{	
			if (isspace(*char_ptr)) continue;
			char_ptr++; 
			i++;
			if (i > (INT)48) break;
		}
		*char_ptr	= /* NULL; AK 290494 */ '\0';
		if (strlen(name) == 0)
			return(ERROR);
		if ((f = fopen(name,"r")) == NULL)
		{	
			printf("Unable to open %s\n",name);
			return(ERROR);
		}
	}
	if ( fscanf(f," %ld",&zzno_cyclos) == 0 || zzno_cyclos < 1L ||
	    (zzcyclo_table
	    = (CYCLO_DATA *) SYM_calloc((int)zzno_cyclos,sizeof(CYCLO_DATA))
	    ) == NULL
	    )
	{	
		zzno_cyclos	= 0L;
		printf("\nCyclo data table creation error");
		return(ERROR);
	}
	ptr	= zzcyclo_table - 1;
	for (i=0L;i<zzno_cyclos;i++)
	{	
		ptr++;
		ptr->index	= callocobject();
		objectread(f,ptr->index);
		ptr->deg	= callocobject();
		objectread(f,ptr->deg);
		ptr->poly	= callocobject();
		objectread(f,ptr->poly);
		ptr->autos	= callocobject();
		objectread(f,ptr->autos);
	}
	cyclo_table_set	= 1L;
	fclose(f);
	return(OK);
}

static CYCLO_DATA *add_cyclo_data(index) OP index;
/* AK 200891 V1.3 */
{	
	CYCLO_DATA	*ptr = NULL;
	OP	ptr_eins, ptr_zwei;
	
	if ((ptr = cyclo_ptr(index)) != NULL)
		return(ptr);
	ptr	= (CYCLO_DATA *) SYM_calloc(1,sizeof(CYCLO_DATA));
	if (ptr == NULL)
		return(NULL);
	ptr->index	= callocobject();
	copy(index,ptr->index);
	ptr->poly	= callocobject();
	if (make_cyclotomic_monopoly(index,ptr->poly) == ERROR)
	{	
		SYM_free(ptr);
		return(NULL);
	}
	ptr_eins	= ptr->poly;
	while(ptr_eins != NULL)
	{	
		ptr_zwei	= ptr_eins;
		ptr_eins	= S_L_N(ptr_eins);
	}
	ptr->deg	= callocobject();
	copy(S_PO_S(ptr_zwei),ptr->deg);
	ptr->autos	= callocobject();
	make_coprimes(ptr->index,ptr->autos);
	ptr_eins	= callocobject();
	init(SYMLIST,ptr_eins);
	/*	Some compilers require this cast, others dislike it	*/
	/* (CYCLO_DATA *) S_L_S(ptr_eins)	= ptr; */
	C_L_S(ptr_eins,ptr);
	/* S_L_N(ptr_eins)	= NULL; */
	C_L_N(ptr_eins,NULL);
	if (cyclo_list_set)
		S_L_N(zzcyclo_tail)	=	ptr_eins;
	else
	{	
		cyclo_list_set	= 1L;
		zzcyclo_list	= ptr_eins;
	}
	zzcyclo_tail	= ptr_eins;
	return(ptr);
}

static CYCLO_DATA *cyclo_ptr(index) OP index;
/* AK 200891 V1.3 */
{	
	CYCLO_DATA	*ptr = NULL;
	OP	list_ptr;
	INT	i;
	if (cyclo_table_set)
	{	
		ptr	= zzcyclo_table - 1;
		for (i=0L;i<zzno_cyclos;i++)
		{	
			ptr++;
			if (EQ(index,ptr->index) == TRUE)
				return(ptr);
		}
	}
	if (cyclo_list_set)
	{	
		list_ptr	= zzcyclo_list;
		while (list_ptr != NULL)
		{	
			ptr	= (CYCLO_DATA *) S_L_S(list_ptr);
			if (ptr == NULL)
				error("cyclo_ptr: null pointer\n");
			if (EQ(index,ptr->index) == TRUE)
				return(ptr);
			list_ptr	= S_L_N(list_ptr);
		}
	}
	return(NULL);
}

static INT free_cyclo_list()
/* 29.10.91: TPMcD */
{	
	OP	list_ptr;
	OBJECTSELF list_self;
	CYCLO_DATA *cp;
	list_ptr = zzcyclo_list;
	while (list_ptr != NULL)
	{	
		list_self	= S_O_S(list_ptr);
		cp = (CYCLO_DATA *)S_L_S(list_ptr);
		SYMfreeall(cp->index);
		SYMfreeall(cp->deg);
		SYMfreeall(cp->poly);
		SYMfreeall(cp->autos);
		SYM_free(cp);
		C_L_S(list_ptr,NULL); /* Wg speicherverwaltung */
		list_ptr	= S_L_N(list_ptr);
	}
	return(OK);
}

INT print_cyclo_data(ptr) CYCLO_DATA *ptr;
/* AK 200891 V1.3 */
{	
	printf("Index ");
	print(ptr->index);
	printf("\tDegree ");
	println(ptr->deg);
	printf("Polynomial ");
	println(ptr->poly);
	printf("Automorphism exponents ");
	println(ptr->autos);
}

static INT free_cyclo_table()
/* AK 310893 */
{
	CYCLO_DATA	*ptr;
	INT	i;

	if (!cyclo_table_set)
		return(ERROR);
	ptr	= zzcyclo_table;
	for (i=0L;i<zzno_cyclos;i++)
	{	
		SYMfreeall(ptr->index);
		SYMfreeall(ptr->deg);
		SYMfreeall(ptr->poly);
		SYMfreeall(ptr->autos);
		ptr++;
	}
	return(OK);
}

INT print_cyclo_table()
/* AK 200891 V1.3 */
{	
	CYCLO_DATA	*ptr;
	INT	i;

	if (!cyclo_table_set)
		return(ERROR);
	printf("Number of cyclo data on table: %ld\n",zzno_cyclos);
	ptr	= zzcyclo_table;
	for (i=0L;i<zzno_cyclos;i++)
	{	
		printf("Table item %ld: ",i);
		print_cyclo_data(ptr);
		ptr++;
	}
	return(OK);
}

INT print_cyclo_list()
/* AK 200891 V1.3 */
{	
	CYCLO_DATA	*ptr;
	OP	list_ptr;
	INT	i = 0L;

	if (!cyclo_list_set)
		return(ERROR);
	printf("Cyclo data in list:\n");
	list_ptr	= zzcyclo_list;
	while (list_ptr != NULL)
	{	
		printf("List item %ld: ",i++);
		print_cyclo_data((CYCLO_DATA *) S_L_S(list_ptr));
		list_ptr	= S_L_N(list_ptr);
	}
	return(OK);
}

INT save_cyclo_list(filename) char *filename;
/* 4.04.91: TPMcD. */ /* AK 200891 V1.3 */
{
	CYCLO_DATA	*ptr;
	OP	list_ptr;
	INT	i = 0L, new = 0L;
	FILE	*f;
	char	name[50], *char_ptr;

	if (filename == NULL || (f = fopen(filename,"r+")) == NULL)
	{	
		fflush(stdin);
		printf("\nFile to receive cyclo data: ");
		char_ptr	= name;
		while( (*char_ptr = fgetc(stdin)) != '\n')
		{	
			if (isspace(*char_ptr)) continue;
			char_ptr++; 
			i++;
			if (i > (INT)48) break;
		}
		*char_ptr	= /* NULL; AK 290494 */ '\0';
		if (strlen(name) == 0)
			return(ERROR);
		if ((f = fopen(name,"r+")) == NULL)
		{	
			if((f = fopen(name,"w")) == NULL)
			{	
				printf("Unable to open %s\n",name);
				return(ERROR);
			}
			else
				new	= 1L;
		}
	}
	else
		strcpy(name,filename);
	if (new)
	{	
		fprintf(f,"              \n\n");
		printf("Initialising %s\n",name);
		i	= 0L;
	}
	else
	{	
		fseek(f,0L,0);
		fscanf(f,"%ld",&i);
		fseek(f,0L,2);
		printf("Cyclo data being appended to file %s.\n",name);
	}
	list_ptr	= zzcyclo_list;
	while (list_ptr != NULL)
	{	
		ptr	= (CYCLO_DATA *) S_L_S(list_ptr);
		fprintf(f,"\n");
		objectwrite(f,ptr->index);
		objectwrite(f,ptr->deg);
		objectwrite(f,ptr->poly);
		objectwrite(f,ptr->autos);
		list_ptr	= S_L_N(list_ptr);
		i++;
	}
	fseek(f,0L,0);
	fprintf(f,"%8ld",i);
	fclose(f);
	return(OK);
}

#endif

#ifdef NUMBERTRUE
INT test_number()
{
	OP a = callocobject();
	OP b = callocobject();
	printeingabe("test_number: squareroot(2L,a)");
	squareroot(cons_zwei,a); 
	println(a);
	printeingabe("test_number: squareroot(11L,a)^-1");
	m_i_i(19L,b); 
	squareroot(b,a); 
	invers(a,b); 
	println(b);
	printeingabe("test_number: euler_phi(311L,a)");
	m_i_i(311L,b); 
	euler_phi(b,a); 
	println(b);
	SYMfreeall(a);
	SYMfreeall(b);
	return OK;
}

INT t_MONOPOLY_POLYNOM(a,b) OP a,b;
/* AK 171194 */
{
        OP c,d;

        init(POLYNOM,b);
        while (a != NULL)
                {
                c = callocobject();
                m_iindex_iexponent_monom((INT)0,S_I_I(S_PO_S(a)),c);
                copy(S_PO_K(a),S_PO_K(c));
                insert(c,b,NULL,NULL);
                a = S_L_N(a);
                }
        return OK;
}
        
#endif /* NUMBERTRUE */

INT invers_monopoly(lau, res) OP lau,res;
{
        INT erg = OK;
        erg += b_ou_b(callocobject(),callocobject(),res);
        M_I_I((INT)1,S_B_O(res));
        erg += copy(lau,S_B_U(res));
        C_B_I(res,GEKUERZT);
        ENDR("invers_monopoly");
}


INT degree_monopoly(mp,dg) OP mp,dg;
/*CC 010496*/
{
/* Puts in dg the degree of the MONOPOLY object mp*/
        OP z,za;
        if(not EMPTYP(dg)) freeself(dg);
        if(nullp(mp)){ M_I_I(0L,dg); return OK;}
        z=mp;
        while(z !=NULL)
        {
                za=z;
                z=S_L_N(z);
        }
        copy(S_PO_S(za),dg);
        return(OK);
}

/*
Puts in ld the leading coefficient of the MONOPOLY object mp.
*/

INT ldcf_monopoly(mp,ld) OP mp,ld;
{

        OP z,za;
        if(not EMPTYP(ld)) freeself(ld);
        z=mp;
        while(z !=NULL)
        {
                za=z;
                z=S_L_N(z);
        }
        copy(S_PO_K(za),ld);
        return(OK);
}



INT has_one_variable(a) OP a;
{
/*
Returns TRUE, if a is an  MONOPOLY object, or
                is of type POLYNOM with 0 or 1 variable.
*/
        OP nb;
        if(S_O_K(a)==MONOPOLY)
                return TRUE;
        if(S_O_K(a)==POLYNOM)
        {
                nb=callocobject();
                numberofvariables(a,nb);
                if(S_I_I(nb)<=1L)
                {
                        SYMfreeall(nb);return TRUE;
                }
                SYMfreeall(nb);
        }
        return FALSE;
}

#define callocobject callocobject_trace
#undef callocobject
