/* kl.c */

int nb1=0, nb2=0;

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

#define HASH_MAX 99973
int             ct;
long            compte, wrong, cte, bll;

long            mes[500];
signed char     chemin[200], *bchemin;
signed char     lg_mot;
OP              hash_table[HASH_MAX];

/*#define MEM_LST 1000 */ /* CC 22/02/00*/

unsigned char   ordre;
struct lst     *nfree;
long            cbing, cbang, cbong, brrr;

extern INT      ld_coef();
extern INT      calculv();
extern INT      calculc();
extern INT      calcul2();
extern INT      calculm();
extern INT      calcul_tr();

struct lst_rct
{
   unsigned char   rct[3];
   struct lst_rct *nxt;
};

// GCC 3.4 complains if we do not predeclare the following functions:
INT upper_kl_ls(OP prm, OP vc_prm, OP vc_kl);
INT m_v_mp(OP vc, OP mp);
INT kl_choice();
INT ls_choice();

void
voirbaf(ch, n)
unsigned char  *ch;
int             n;
{
   int             i;
   for (i = 0; i < n; i++, ch++)
      printf("%d ", *ch);
   putchar('\n');
}

void
voirbf(ch)
unsigned char  *ch;
{
   int             i;
   for (i = 0; i < ordre; i++, ch++)
      printf("%d ", *ch);
   putchar('\n');
}

void
voirbif(ch)
signed char    *ch;
{
   ch++;
   while (*ch != -1)
   {
      printf("%d ", *ch);
      ch++;
   }
   putchar('\n');
}

void
voirbof(ch)
signed char    *ch;
{
   int             i;
   ch++;
   for (i = 0; i < 15; i++)
   {
      printf("%d ", *ch);
      ch++;
   }
   putchar('\n');
}



/*
 * factoriel avec des types non SYMMETRICA
 */

int
fct(n)
int             n;
{
   int             tp = 1;
   for (; n >= 1; n--)
      tp *= n;
   return tp;
}

/*
 * Input a permutation a. Output an integer b. b will be the index of a in
 * the list of lexicographic ranged permutations.
 */

INT
indx(a, b)
OP              a, b;
{
   INT             nb, i, lg, j, n, tp;

   if (not EMPTYP(b))
      freeself(b);
   nb = 0;
   lg = S_P_LI(a) - 1L;
   n = 1;

   for (i = lg - 1; i >= 0; i--)
   {
      n = n * (lg - i);
      tp = 0;
      for (j = lg; j >= i + 1; j--)
	 if (S_P_II(a, j) < S_P_II(a, i))
	    tp++;

      nb += tp * n;
   }
   M_I_I(nb, b);
   return OK;
}

/*
 * Intput: ord the order of the symmetric group. n the index of a permutation
 * in the list of lexicographic ranged permutations. Output: res the
 * permutation of index n.
 */

INT
indx_inv(ord, n, res)
OP              ord, n, res;
{
   INT             i, j, b, a, q, ordi;
   OP              c;

   if (not EMPTYP(res))
      freeself(res);
   c = callocobject();
   a = S_I_I(n);
   i = S_I_I(ord);
   m_il_nv(i, c);
   i--;
   j = 0L;
   b = fct(i);
   while (i > 0)
   {
      q = a / b;
      M_I_I(q, S_V_I(c, j));
      a = a % b;
      b /= i;
      i--;
      j++;
   }
   lehmercode(c, res);
   SYMfreeall(c);
   return OK;
}

/*
 * frees the tableau if nb_lgn pointers
 */

void
free2(tb, nb_lgn)
unsigned char **tb, nb_lgn;
{
   int             i = 0;
   unsigned char **btb = tb;

   for (; i < nb_lgn; i++, btb++)
      SYM_free(*btb);
   SYM_free((char *) tb);
}

/*
 * reverse an unsigned char * variable
 */

INT
prm_ret(p1, p2)
unsigned char  *p1, *p2;
{
   int             i;
   for (i = 0; i < ordre; i++, p1++, p2--)
      *p2 = *p1;
   return OK;
}


/*
 * reverse a permutation
 */

INT
reverse_prm(v, w)
OP              v, w;
{
   INT             i, j;

   if (!EMPTYP(w))
      freeself(w);
   m_il_p(S_P_LI(v), w);
   for (i = 0, j = S_P_LI(v) - 1L; j >= 0L; j--, i++)
   {
      M_I_I(S_P_II(v, j), S_P_I(w, i));
   }
   return OK;
}

/*
Reverse the permutations of a vector of permutations
*/

INT reverse_prm_vc(a, b) OP a, b;
{
	int i;

	m_il_v(S_V_LI(a), b);
	for(i=0; i<S_V_LI(a); i++){
		reverse_prm(S_V_I(a, i), S_V_I(b,i));
	}
	return OK;
}

INT
t_pa_v01(pa, v)
OP              pa, v;
{
   int             i, j, av;

   m_il_nv(S_PA_LI(pa) + S_PA_II(pa, S_PA_LI(pa) - 1L), v);
   av = 0;
   j = 0;
   for (i = 0; i < S_PA_LI(pa); i++)
   {
      j += S_PA_II(pa, i) - av;
      av = S_PA_II(pa, i);
      M_I_I(1L, S_V_I(v, j));
      j++;
   }
   return OK;
}


INT
irr(pa, mot)
OP              pa;
signed char   **mot;
{
   signed char   **ttch, **bttch, *bav, *bap;
   signed char     bl, boo, tag, lg, tp;
   int             i, j, k;
   OP              v;

   v = callocobject();
   t_pa_v01(pa, v);

   ttch = (signed char **) SYM_malloc((int) ((S_V_LI(v)) * sizeof(signed char *)));
   bttch = ttch;
   for (i = 0; i < S_V_LI(v); i++)
      *bttch++ = (signed char *) SYM_calloc(1, 1);

   bl = 0;
   while (bl == 0)
   {
      bl = 1;
      boo = 0;
      for (i = 0; i < S_V_LI(v); i++)
      {
	 if (S_V_II(v, i) == 2L)
	    continue;
	 if (S_V_II(v, i) == 0)
	 {
	    boo = 1;
	    tag = i;
	    continue;
	 } else
	 {
	    if (boo == 0)
	       continue;
	    else
	    {
	       boo = 0;
	       bl = 0;
	       M_I_I(2L, S_V_I(v, tag));
	       M_I_I(2L, S_V_I(v, i));
	       bav = ttch[tag];
	       tp = 0;
	       bap = ttch[tag + 1];
	       for (j = tag + 1; j < i; j++)
	       {
		  tp += *(ttch[j]);
	       }
	       ttch[tag] = (signed char *) SYM_realloc(bav, tp + 2 + 1);
	       bav = ttch[tag];
	       *bav++ = tp + 2;
	       *bav++ = 0;
	       for (j = tag + 1; j < i; j++)
	       {
		  bap = ttch[j];
		  lg = *bap;
		  *bap++ = 0;
		  for (k = 0; k < lg; k++)
		     *bav++ = *bap++;
	       }
	       *(ttch[i]) = 0;
	       *bav = 1;
	    }
	 }
      }				/* End of for */
   }				/* End of while */
   bttch = ttch;
   lg = 0;
   for (i = 0; i < S_V_LI(v); i++, bttch++)
      lg += **bttch;
   *mot = (signed char *) SYM_malloc(lg * sizeof(signed char) + 1);
   bap = *mot;
   bttch = ttch;
   for (i = 0; i < S_V_LI(v); i++)
   {
      bav = *bttch;
      lg = *bav++;
      for (j = 0; j < lg; j++, bav++, bap++)
      {
	 *bap = (*bav == 0 ? 'a' : 'b');
      }
      SYM_free(*bttch);
      bttch++;
   }
   *bap = 0;
   SYMfreeall(v);
   SYM_free((signed char *) ttch);
   return OK;
}


void
m_tb(ch, cp, tb)
signed char    *ch, *tb;
int            *cp;
{
   signed char     boo = 0;
   *tb = -1;
   tb++;
   while (*ch)
   {
      if (*ch == 'a')
      {
	 boo = 1;
	 *tb = 'a';
      } else if (boo == 1)
      {
	 *tb++ = *cp;
	 cp++;
	 boo = 0;
	 *tb = 'b';
      } else
	 *tb = 'b';
      ch++;
      tb++;
   }
   *tb = -1;
}


void
rec(tb)
signed char    *tb;
{
   signed char    *btb, boo;
   signed char     i, min, tp;
   signed char    *ba, *bb, *bntb, *pos, ntb[200];

   btb = tb + 1;
   boo = 0;

   while (*btb != -1)
   {
      if (*btb == 'a')
	 boo = 1;
      if (*btb == 'b' && boo == 1)
      {
	 bb = btb - 1;
	 min = *bb;
	 bb--;
	 while (*bb != 'a')
	 {
	    if (*bb < min)
	       min = *bb;
	    bb--;
	 }
	 bntb = ntb;
	 ba = tb;
	 while (ba < bb)
	    *bntb++ = *ba++;
	 pos = bntb;
	 ba = btb + 1;
	 bntb++;
	 while (*ba != -1)
	    *bntb++ = *ba++;
	 *bntb = -1;
	 for (i = min; i >= 0; i--)
	 {
	    *bchemin = i;
	    *pos = i;
	    bchemin++;
	    rec(ntb);
	    bchemin--;
	 }
	 return;
      }
      btb++;
   }
   bb = chemin;
   tp = 0;
   for (i = 0; i < lg_mot; i++, bb++)
      tp += *bb;
   mes[tp]++;
}

INT
init_mes_ch_tb(m, c, t)
long           *m;
signed char    *c, *t;
{
   int             i;
   for (i = 0; i < 200; i++)
   {
      *m++ = 0;
      *c++ = *t++ = 0;
   }
   for (; i < 500; i++)
   {
      *m++ = 0;
      *t++ = 0;
   }
   return OK;
}


INT
capa_v(mot, pds, res)
OP              pds, res;
signed char    *mot;
{
   OP              d, cel;
   static signed char tb[500];
   int            *cp = (int *) SYM_malloc(S_V_LI(pds) * sizeof(int));
   int             i, *bcp, lg;
   long           *bmes;

   /*
    * init_mes_ch_tb(mes, chemin, tb);
    */

   lg_mot = strlen(mot);
   bcp = cp;
   for (i = 0; i < S_V_LI(pds); i++)
      *bcp++ = S_V_II(pds, i);

   m_tb(mot, cp, tb);

   SYM_free((signed char *) cp);
   SYM_free(mot);
   bchemin = chemin;
   rec(tb);

   bchemin = chemin;
   for (i = 0; i < lg_mot; i++)
      *bchemin++ = 0;

   bmes = mes;
   while (*bmes)
      bmes++;
   lg = bmes - mes;
   bmes = mes;

   init(MONOPOLY, res);
   d = res;
   for (i = 0; i < lg; i++)
   {
      cel = callocobject();
      b_skn_mp(callocobject(), callocobject(), NULL, cel);
      M_I_I(i, S_PO_S(cel));
      M_I_I((INT) * bmes, S_PO_K(cel));
      *bmes++ = 0;
      c_l_n(d, cel);
      d = cel;
   }
   if (d != res)
   {
      d = S_L_N(res);
      c_l_s(res, S_L_S(d));
      c_l_n(res, S_L_N(d));
      c_l_n(d, NULL);
      c_l_s(d, NULL);
      SYMfreeall(d);
   }
   return OK;
}

INT
capa_sym(pa, pds, res)
OP              pa, pds, res;
{
   signed char    *mot;
   irr(pa, &mot);
   capa_v(mot, pds, res);
   return OK;
}


INT
cut_v(v, d, vc)
OP              v, vc;
INT             d;
{
   signed char     tmp;
   int             i;

   m_il_nv(d, vc);
   tmp = d < S_V_LI(v) ? d : S_V_LI(v);
   for (i = 0; i < tmp; i++)
      M_I_I(S_V_II(v, i), S_V_I(vc, i));
   return OK;
}

/*
 * Computes the KL polynom indexed by p1 and p2, with p1 vexillary
 */

INT
kl_vex(p1, p2, res)
OP              p1, p2, res;
{
   OP              c, v1, v2, pds, vc2, u, pa;
   int             i, j, k, lg, offset, d;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   c = callocobject();
   v1 = callocobject();
   v2 = callocobject();
   pds = callocobject();
   vc2 = callocobject();

   copy(S_P_S(p2), v2);		/* CC 07-01-98 */
   fastrectr(p1, c);
   m_il_nv(S_V_LI(c), pds);
   /* pds is the vector of the distances from the rectrices of p1 to p2 */
   for (i = 0; i < S_V_LI(c); i++)
   {
      u = S_V_I(c, i);
      lg = S_V_II(u, 0) + S_V_II(u, 1);
      cut_v(v2, lg, vc2);
      sort(vc2);
      m_il_nv(lg, v1);
      offset = S_V_II(u, 2) + 1;/* CC 07-01-98 */
      d = S_V_II(u, 0) - 1;	/* CC 07-01-98 */
      while (d >= 0 && lg + offset <= S_P_LI(p1))
      {

	 for (j = d; j < S_V_II(u, 1) + S_V_II(u, 0); j++)	/* CC 19-01-98 */
	    M_I_I(offset + j + 1, S_V_I(v1, j));

	 for (j = d; j < lg; j++)	/* CC 07-01-98 */
	    if (S_V_II(vc2, j) < S_V_II(v1, j))
	       break;
	 if (j != lg)
	 {
	    M_I_I(S_V_II(u, 0) - d - 1, S_V_I(pds, S_V_LI(c) - i - 1));
	    break;
	 } else
	 {
	    d--;
	    offset++;
	 }
      }
      if (d < 0 || lg + offset > S_P_LI(p1))
	 M_I_I(S_V_II(u, 0) - d - 1, S_V_I(pds, S_V_LI(c) - i - 1));
      freeself(v1);
      freeself(vc2);
      if (S_V_II(pds, i) == -1)
      {
	 m_il_nv(1L, res);
	 SYMfreeall(v1);
	 SYMfreeall(v2);
	 SYMfreeall(pds);
	 SYMfreeall(vc2);
	 SYMfreeall(c);
	 return OK;
      }
   }
   pa = callocobject();
   lehmercode_permutation(p1, v1);
   sort(v1);
   m_v_pa(v1, pa);
   capa_sym(pa, pds, res);
   SYMfreeall(v1);
   SYMfreeall(v2);
   SYMfreeall(pds);
   SYMfreeall(vc2);
   SYMfreeall(c);
   SYMfreeall(pa);

   return OK;
}

/*
 * The permutation w gets increasing beetween the indices i0 and i1
 * tri([3,5,2,1,4,6],1,3)-> <- [3,2,4,5,1,6]
 */

INT
tri(w, i0, i1)
OP              w;
INT             i0, i1;
{
   INT             i, j, tp;

   for (i = i1; i > i0; i--)
      for (j = i0; j < i; j++)
	 if (S_P_II(w, j) > S_P_II(w, j + 1))
	 {
	    tp = S_P_II(w, j);
	    M_I_I(S_P_II(w, j + 1), S_P_I(w, j));
	    M_I_I(tp, S_P_I(w, j + 1));
	 }
   return OK;
}

/*
 * returns 1 if u[i]<u[i+1] => w[i]<w[i+1] 0 if not
 */

INT
normal_rep_L(u, w)
OP              u, w;
{
   INT             i, av, aw;

   av = S_P_II(u, 0L);
   aw = S_P_II(w, 0L);
   for (i = 1L; i < S_P_LI(u); i++)
   {
      if (S_P_II(u, i) > av)
      {
	 if (S_P_II(w, i) < aw)
	    return 0L;
      }
      av = S_P_II(u, i);
      aw = S_P_II(w, i);
   }
   return 1L;
}

/*
 * u[i]<u[i+1] => w[i]<w[i+1]
 */

INT
min_rep_L(u, w)
OP              u, w;
{
   INT             i0, i, av, ret;
   signed char     boo;

   ret = OK;
   av = S_P_II(u, 0L);
   boo = 0;
   for (i = 1L; i < S_P_LI(u); i++)
   {
      if (S_P_II(u, i) > av)
      {
	 if (boo == 0)
	 {
	    i0 = i - 1L;
	    boo = 1;
	 }
      } else if (boo == 1)
      {
	 boo = 0;
	 ret += tri(w, i0, i - 1L);
      }
      av = S_P_II(u, i);
   }
   if (boo == 1)
      ret += tri(w, i0, i - 1L);
   return ret;
}

/*
 * i<j u[i]=u[j]-1 => h<k w[h]=u[i] w[k]=u[j]
 */

INT
min_rep_R(u, w)
OP              u, w;
{
   OP              w1, u1;

   u1 = callocobject();
   w1 = callocobject();
   invers_permutation(u, u1);
   invers_permutation(w, w1);
   min_rep_L(u1, w1);
   invers_permutation(w1, w);
   SYMfreeall(w1);
   SYMfreeall(u1);
   return OK;
}

/*
 * returns 1L if i<j u[i]=u[j]-1 => h<k w[h]=u[i] w[k]=u[j] 0L, if not.
 */

INT
normal_rep_R(u, w)
OP              u, w;
{
   OP              w1, u1;
   INT             ret;

   u1 = callocobject();
   w1 = callocobject();
   invers_permutation(u, u1);
   invers_permutation(w, w1);
   ret = normal_rep_L(u1, w1);
   SYMfreeall(w1);
   SYMfreeall(u1);
   return ret;
}

/*
 * Normalizes w according with u
 */
INT
min_rep(u, w)
OP              u, w;
{
   INT             ret = OK;
   ret += min_rep_L(u, w);
   ret += min_rep_R(u, w);
   return ret;
}

/*
 * return 1L if w is normalized according with u, 0L, if not.
 */

INT
normal_rep(u, w)
OP              u, w;
{
   if (normal_rep_L(u, w) == 0L)
      return 0L;
   if (normal_rep_R(u, w) == 0L)
      return 0L;
   return 1L;
}

/*
 * return 1L if w is normalized according with u, 0L, if not. ur is the
 * inverse of u
 */

INT
normal_rep_plus(u, ur, w)
OP              u, ur, w;
{
   OP              w1;
   INT             ret;

   if (normal_rep_L(u, w) == 0L)
      return 0L;
   w1 = callocobject();
   invers_permutation(w, w1);
   ret = normal_rep_L(ur, w1);
   SYMfreeall(w1);
   return ret;
}

INT
vx_upper_me(way, ch)
signed char    *ch;
OP              way;
{
   signed char    *bch, *bs, *bt, *bm, av, tp, tot;
   int             i, j, k, m;
   OP              oway;

   oway = callocobject();
   m_il_v(100L, oway);
   tot = 0;

   bch = ch + 2;
   for (i = 2; i <= *ch; i++, bch++)
   {
      j = i;
      av = *bch;
      bs = bch;
      while (j >= 1)
      {
	 k = j - 1;
	 bt = bs - 1;
	 av = *bs;
	 while (k >= 1)
	 {
	    if (*bt > av)
	       break;
	    k--;
	    av = *bt;
	    bt--;
	 }
	 if (k < 1 || k == j - 1)
	    break;
	 tp = *bs + j - k - 1;
	 bm = bt;
	 for (m = k; m >= 1; m--, bm--)
	    if (*bm > *(bt + 1) && *bm < tp)
	       break;
	 if (m < 1)
	    break;
	 tp = *bs;
	 m = j;
	 for (; m > k + 1; m--)
	 {
	    M_I_I((INT) m - 1L, S_V_I(oway, tot));
	    tot++;
	    *bs = *(bs - 1);
	    bs--;
	 }
	 *bs = tp + j - m;
	 j = k + 1;
      }				/* end of while(j>= 1) */
   }
   m_il_v(tot, way);
   for (i = 0; i < tot; i++)
      M_I_I(S_V_II(oway, i), S_V_I(way, i));
   SYMfreeall(oway);
   return OK;
}

INT
t_char_v(ch, v)
OP              v;
signed char    *ch;
{
   int             i;
   ch++;
   for (i = 0; i < (int) S_V_LI(v); i++, ch++)
      M_I_I((INT) * ch, S_V_I(v, i));
   return OK;
}

/*
 * transforms a unsigned char * variable ch  to a Permutation Object p.
 */

INT
t_uchar_p(ch, p)
OP              p;
unsigned char  *ch;
{
   int             i;
   /*
    * if(!EMPTYP(p)) freeself(p);
    */
   for (i = 0; i < ordre; i++, ch++)
      M_I_I((INT) * ch, S_P_I(p, i));
   return OK;
}


/*
 * transforms a Permutation Object p to a unsigned char *, ch.
 */
unsigned char  *
t_p_uchar(p)
OP              p;
{
   int             i;
   unsigned char  *ch = (unsigned char *) SYM_malloc((unsigned) (S_P_LI(p) + 1) * sizeof(unsigned char)),
                  *bch;

   bch = ch;
   for (i = 0; i < (int) S_P_LI(p); i++, bch++)
      *bch = (unsigned char) S_P_II(p, i);
   return ch;
}

/*
	Transforms a vector Object to a signed char * ch
*/

signed char    *
t_v_lgchar(v)
OP              v;
{
   int             i;
   signed char    *ch = (signed char *) SYM_malloc((int) S_V_LI(v) + 1),
                  *bch;

   bch = ch;
   *bch++ = (signed char) S_V_LI(v);
   for (i = 0; i < (int) S_V_LI(v); i++)
      *bch++ = (signed char) S_V_II(v, i);
   return ch;
}


/*
 * vex is should be one of the nearest vexillary permutation upon
 * perm. way is the way to go.
 */


INT
vx_upper(perm, way, vex)
OP              perm, way, vex;
{
   OP              v = callocobject();
   signed char    *ch;

   lehmercode_permutation(perm, v);
   ch = t_v_lgchar(v);
   vx_upper_me(way, ch);
   t_char_v(ch, v);
   SYM_free(ch);
   lehmercode_vector(v, vex);
   SYMfreeall(v);
   return OK;
}


/*
 * returns 1 if a is the code of the last permutation ( eg (3, 2, 1 , 0) for
 * the symmetric group of order 4 = length of the code), 0 if not.
 */

INT
nxt_vx_code(a, b)
OP              a, b;
{
   int             lgi, k, i, h, xnv, min, max;
   register int    j;

   if (not EMPTYP(b))
      freeself(b);
   lgi = S_V_LI(a);
   m_il_nv(lgi, b);
   i = lgi - 2;
   h = 1;
essai:for (; i >= 0; i--, h++)
      if (S_V_II(a, i) != h)
	 break;
   if (i == -1)
      return 1L;
   xnv = S_V_II(a, i) + 1;
   if (i == 0 || S_V_II(a, i - 1) >= xnv)
   {
      M_I_I(xnv, S_V_I(b, i));
      for (j = 0; j < i; j++)
	 M_I_I(S_V_II(a, j), S_V_I(b, j));
      return 0L;
   }
   min = S_V_II(a, i - 1);
   for (j = i - 2; j >= 0; j--)
   {
      if (S_V_II(a, j) > min)
	 break;
      min = S_V_II(a, j);
   }
   if (j >= 0)
      max = xnv + i - j - 1;
   else
   {
      M_I_I(xnv, S_V_I(b, i));
      for (j = 0; j < i; j++)
	 M_I_I(S_V_II(a, j), S_V_I(b, j));
      return 0L;
   }

   for (k = j; k >= 0; k--)
   {
      if (S_V_II(a, k) > min &&
	  S_V_II(a, k) < max)
      {
	 i--;
	 h++;
	 goto essai;
      }
   }
   M_I_I(xnv, S_V_I(b, i));
   for (j = 0; j < i; j++)
      M_I_I(S_V_II(a, j), S_V_I(b, j));
   return 0L;
}

/*
a is a permutation,
b is the next  vexillary permutationin the lexico order 
need to enumerate all vexillary permutations above a
*/

INT nxt_vx( a,  b) OP a, b;
{
	OP aa, bb;
	INT ret=0L;

	aa=callocobject(); bb=callocobject();
	lehmercode_permutation(a, aa);
	ret=nxt_vx_code(aa, bb);
	lehmercode(bb,b);
	SYMfreeall(aa); SYMfreeall(bb);
	return ret;
}

/*
 * transforms a 01 tableau into a permutation
 */

int
t_01_prm(tb, tb_cumul, col_cum, nb_col, nb_lgn, pprm)
unsigned char **tb, **tb_cumul, *col_cum, nb_col, nb_lgn, **pprm;
{
   int             i = 1, j = 0, k;
   unsigned char  *prm = *pprm, *baf = *tb, *bcol = col_cum, av = 0, *bcumul;

   for (; j < nb_col; j++, bcol++, baf++)
   {
      for (k = 0; k < *baf; k++)
	 *prm++ = k + 1 + av;
      av = *bcol;
   }

   tb++;
   for (; i < nb_lgn; i++)
   {
      bcumul = *tb_cumul;
      av = 0;
      bcol = col_cum;
      baf = *tb;
      for (j = 0; j < nb_col; j++, bcol++, baf++, bcumul++)
      {
	 for (k = 0; k < *baf; k++)
	    *prm++ = k + 1 + av + *bcumul;
	 av = *bcol;
      }
      tb++;
      tb_cumul++;
   }

   return 0;
}

/*
 * Views a tableau of nb_lgn lines and nb_col columns
 */

void
view_01(tb, nb_lgn, nb_col)
unsigned char **tb, nb_lgn, nb_col;
{
   int             i = 0, j;

   putchar('\n');
   for (; i < nb_lgn; i++)
   {
      for (j = 0; j < nb_col; j++)
	 printf("%d ", *(*(tb + i) + j));
      putchar('\n');
   }
}

/*
 * Views a tableau of nb_lines lines and lgn[index] columns
 */

void
view_pos(tb, nb_lgn, lgn)
unsigned char **tb, nb_lgn, *lgn;
{
   int             i = 0, j;

   putchar('\n');
   for (; i < nb_lgn; i++)
   {
      for (j = 0; j < *lgn; j++)
	 printf("%d ", *(*(tb + i) + j));
      lgn++;
      putchar('\n');
   }
}

/*
 * Computes in prm1 the inverse of the permutation prm
 */

int
inv_prm(prm, prm1)
unsigned char  *prm, *prm1;
{
   int             i = 0;

   for (; i < ordre; i++)
      prm1[*prm++ - 1] = i + 1;
   return 0;
}

/*
 * Computes in lst the rectrices of prm returns the number of rectrices.
 */

unsigned char
rct(prm, lst)
unsigned char  *prm;
struct lst_rct **lst;
{
   struct lst_rct *bp;
   int             i = 0, i1, k;
   unsigned char  *prm1 = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   unsigned char  *bprm = prm, *bprm2, *bprm1;
   unsigned char   y, nb = 0;

   inv_prm(prm, prm1);
   *lst = NULL;
   for (; i < ordre - 1; i++, bprm++)
   {
      if (*bprm > *(bprm + 1))
      {
	 k = *bprm;
	 bprm1 = prm1 + k - 1;
	 for (; k >= *(bprm + 1); k--, bprm1--)
	 {
	    if (*bprm1 >= i + 2 && *(bprm1 + 1) <= i + 1)
	    {
	       y = 0;
	       bprm2 = prm;
	       for (i1 = 0; i1 <= i; i1++, bprm2++)
		  if (*bprm2 < k)
		     y++;
	       bp = (struct lst_rct *)
		  SYM_malloc(sizeof(struct lst_rct));
	       nb++;
	       *bp->rct = y;
	       *(bp->rct + 1) = i + 1 - y;
	       *(bp->rct + 2) = k - y;
	       bp->nxt = *lst;
	       *lst = bp;
	    }
	 }
      }
   }
   SYM_free(prm1);
   return nb;
}

/*
 * Libere l'espace alloue aux rectrices
 */

void
free_lst_rct(lst)
struct lst_rct *lst;
{
   struct lst_rct *bp;
   while (lst != NULL)
   {
      bp = lst;
      lst = lst->nxt;
      SYM_free((char *) bp);
   }
}


/*
 * Views rectrices
 */

INT
view_rct(lst)
struct lst_rct *lst;
{
   unsigned char  *baf;
   int             i;

   while (lst)
   {
      baf = lst->rct;
      for (i = 0; i < 3; i++, baf++)
      {
	 if (*baf < 10)
	    printf("%d ", *baf);
	 else
	    printf("%c ", *baf + 'A' - 10);
      }
      lst = lst->nxt;
      if (lst)
	 putchar('\t');
      else
	 putchar('\n');
   }
   return 0L;
}

/*
 * prm is a permutation defined by the rectrices lst returns 1 if prm <=
 * prm_gen 0 if not
 */

int
cmp_upper_prm(lst, prm_gen)
unsigned char  *prm_gen;
struct lst_rct *lst;
{
   unsigned char   tmp, tp, *baf, nb;
   int             i;

   while (lst != NULL)
   {
      tmp = lst->rct[0] + lst->rct[2];
      tp = lst->rct[0] + lst->rct[1];
      baf = prm_gen;
      nb = 0;
      for (i = 0; i < tp; i++, baf++)
      {
	 if (*baf > tmp)
	 {
	    nb++;
	    if (nb == lst->rct[1])
	       break;
	 }
      }
      if (i == tp)
	 break;
      lst = lst->nxt;
   }
   if (lst != NULL)
      return 0;
   else
      return 1;
}

/*
 * Returns the weight of a permutation prm
 */

unsigned char
pds_prm(prm)
unsigned char  *prm;
{
   register unsigned char *baf;
   unsigned char   we = 0;
   int             i = 0, j;

   for (; i < ordre - 1; i++, prm++)
   {
      baf = prm + 1;
      for (j = i + 1; j < ordre; j++, baf++)
      {
	 if (*prm > *baf)
	    we++;
      }
   }
   return we;
}

/*
 * Input: prm={3,4,1,5,2} Output:	prm1={3,2,5,1,4} i.e prm1[i]=
 * ordre+1-prm[i]
 */

void
cpl(prm, prm1)
unsigned char  *prm, *prm1;
{
   int             i = 0;
   for (; i < ordre; i++, prm++, prm1++)
      *prm1 = ordre + 1 - *prm;
}

/*
 * Computes in flg, the index of cycle of each component of the inverse of
 * prm. return the number of cycles of prm
 */

unsigned char
nb_cycles(prm, flg)
unsigned char  *prm, *flg;
{
   unsigned char   av = *prm, *bprm = prm + 1, nb = 0;
   int             i = 1;

   flg[*prm - 1] = 0;
   for (; i < ordre; i++, bprm++)
   {
      if (*bprm < av)
	 nb++;
      av = *bprm;
      flg[*bprm - 1] = nb;
   }
   return nb + 1;
}

/*
 * prm is a permutation. Computes in prm1 the inverse of the permutation.
 * return the number of cycles
 */

unsigned char
cycle_inv_prm(prm, prm1)
unsigned char  *prm, *prm1;
{
   unsigned char   av = *prm, *bprm = prm + 1, nb = 0;
   int             i = 1;

   prm1[av - 1] = 1;
   for (; i < ordre; i++, bprm++)
   {
      prm1[*bprm - 1] = i + 1;
      if (*bprm < av)
	 nb++;
      av = *bprm;
   }
   return nb + 1;
}

/*
 * Builds col_cum and col_cum_ret
 */

int
build_col_cum(col, col_cum, col_cum_ret, nb_col)
unsigned char  *col, **col_cum, **col_cum_ret, nb_col;
{
   int             i;
   unsigned char  *bdr = col, *brv = col + nb_col - 1;
   unsigned char   av = 0, av2 = 0;
   unsigned char  *bcum = *col_cum, *bret = *col_cum_ret;

   *bcum++ = 0;
   *bret++ = 0;
   for (i = 0; i < nb_col; i++, bdr++, brv--, bcum++, bret++)
   {
      *bcum = *bdr + av;
      *bret = *brv + av2;
      av = *bcum;
      av2 = *bret;
   }
   return 0;
}


/*
 * prm is the input, the other parameters are outputs. Computes in *tb the
 * tableau of 01. nb_lgn is the number if lines of this tableau. nb_col is
 * the number if columns of this tableau. lgn is the tableau of the sum of
 * components of each line. col is the tableau of the sum of components of
 * each column.
 */

INT
build_01_el(prm, nb_lgn, lgn, tb, nb_col, col, tb_cumul)
unsigned char  *prm, *nb_col, *nb_lgn, **col, **lgn;
unsigned char ***tb, ***tb_cumul;
{
   unsigned char **btb, **bcumul;
   unsigned char  *bprm, *prm1, *bflg, *flg, *baf, *bas, *bav, *bs;
   int             i, j, k;
   unsigned char   tag, av;

   flg = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   prm1 = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));

   *nb_lgn = cycle_inv_prm(prm, prm1);
   *lgn = (unsigned char *) SYM_malloc(*nb_lgn * sizeof(unsigned char));


   *tb = (unsigned char **) SYM_malloc(*nb_lgn * sizeof(unsigned char *));
   *tb_cumul = (unsigned char **) SYM_malloc(*nb_lgn * sizeof(unsigned char *));
   btb = *tb;
   bcumul = *tb_cumul;

   *nb_col = nb_cycles(prm1, flg);
   *col = (unsigned char *) SYM_malloc(*nb_col * sizeof(unsigned char));
   for (i = 0; i < *nb_lgn; i++, btb++, bcumul++)
   {
      *btb = (unsigned char *) SYM_calloc(*nb_col, sizeof(unsigned char));
      *bcumul = (unsigned char *) SYM_calloc(*nb_col, sizeof(unsigned char));
   }

   btb = *tb;
   *(*btb + *flg) = 1;
   baf = *lgn;
   bprm = prm + 1;
   av = *prm;
   tag = 1;
   bflg = flg + 1;
   for (i = 1; i < ordre; i++, bprm++, bflg++)
   {
      if (*bprm < av)
      {
	 *baf = tag;
	 baf++;
	 btb++;
	 tag = 1;
      } else
	 tag++;
      av = *bprm;
      (*(*btb + *bflg))++;
   }

   *baf = tag;
   bprm = prm1 + 1;
   baf = *col;
   av = *prm1;
   tag = 1;
   for (i = 1; i < ordre; i++, bprm++)
   {
      if (*bprm < av)
      {
	 *baf = tag;
	 tag = 1;
	 baf++;
      } else
	 tag++;
      av = *bprm;
   }
   *baf = tag;

   baf = **tb_cumul;
   bs = **tb;

   for (j = 0; j < *nb_col; j++, baf++, bs++)
   {
      *baf = *bs;
   }
   bcumul = *tb_cumul + 1;
   btb = *tb + 1;
   bav = *(bcumul - 1);
   for (i = 1; i < *nb_lgn - 1; i++, btb++, bcumul++)
   {
      bs = *btb;
      baf = *bcumul;
      for (j = 0; j < *nb_col; j++, bav++, bs++, baf++)
      {
	 *baf = *bav + *bs;
      }
      bav = *bcumul;
   }
   SYM_free(flg);
   SYM_free(prm1);

   return 0L;
}

/*
 * prm is the input, the other parameters are outputs. Computes in *tb the
 * tableau of 01. nb_lgn is the number if lines of this tableau. nb_col is
 * the number if columns of this tableau. lgn is the tableau of the sum of
 * components of each line. col is the tableau of the sum of components of
 * each column.
 */

int
build_01(prm, nb_lgn, lgn, tb, nb_col, col, tb_cumul, tb_cumul2)
unsigned char  *prm, *nb_col, *nb_lgn, **col, **lgn;
unsigned char ***tb, ***tb_cumul, ***tb_cumul2;
{
   unsigned char **btb, **bcumul, **bcumul2;
   unsigned char  *bprm, *prm1, *bflg, *flg, *baf, *bas, *bav, *bs;
   int             i, j, k;
   unsigned char   tag, av;

   flg = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   prm1 = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));

   *nb_lgn = cycle_inv_prm(prm, prm1);
   *lgn = (unsigned char *) SYM_malloc(*nb_lgn * sizeof(unsigned char));


   *tb = (unsigned char **) SYM_malloc(*nb_lgn * sizeof(unsigned char *));
   *tb_cumul = (unsigned char **) SYM_malloc(*nb_lgn * sizeof(unsigned char *));
   *tb_cumul2 = (unsigned char **) SYM_malloc(*nb_lgn * sizeof(unsigned char *));
   btb = *tb;
   bcumul = *tb_cumul;
   bcumul2 = *tb_cumul2;

   *nb_col = nb_cycles(prm1, flg);
   *col = (unsigned char *) SYM_malloc(*nb_col * sizeof(unsigned char));
   for (i = 0; i < *nb_lgn; i++, btb++, bcumul++, bcumul2++)
   {
      *btb = (unsigned char *) SYM_calloc(*nb_col, sizeof(unsigned char));
      *bcumul = (unsigned char *) SYM_calloc(*nb_col, sizeof(unsigned char));
      *bcumul2 = (unsigned char *) SYM_calloc(*nb_col, sizeof(unsigned char));
   }

   btb = *tb;
   *(*btb + *flg) = 1;
   baf = *lgn;
   bprm = prm + 1;
   av = *prm;
   tag = 1;
   bflg = flg + 1;
   for (i = 1; i < ordre; i++, bprm++, bflg++)
   {
      if (*bprm < av)
      {
	 *baf = tag;
	 baf++;
	 btb++;
	 tag = 1;
      } else
	 tag++;
      av = *bprm;
      (*(*btb + *bflg))++;
   }

   *baf = tag;
   bprm = prm1 + 1;
   baf = *col;
   av = *prm1;
   tag = 1;
   for (i = 1; i < ordre; i++, bprm++)
   {
      if (*bprm < av)
      {
	 *baf = tag;
	 tag = 1;
	 baf++;
      } else
	 tag++;
      av = *bprm;
   }
   *baf = tag;

   baf = **tb_cumul;
   bas = **tb_cumul2;
   bs = **tb;
   av = 0;

   for (j = 0; j < *nb_col; j++, baf++, bs++, bas++)
   {
      *baf = *bs;
      *bas = *bs + av;
      av = *bas;
   }
   bcumul = *tb_cumul + 1;
   bcumul2 = *tb_cumul2 + 1;
   btb = *tb + 1;
   bav = *(bcumul - 1);
   for (i = 1; i < *nb_lgn - 1; i++, btb++, bcumul++, bcumul2++)
   {
      bs = *btb;
      baf = *bcumul;
      bas = *bcumul2;
      av = 0;
      for (j = 0; j < *nb_col; j++, bav++, bs++, baf++, bas++)
      {
	 *baf = *bav + *bs;
	 *bas = *baf + av;
	 av = *bas;
      }
      bav = *bcumul;
   }
   SYM_free(flg);
   SYM_free(prm1);

   return 0;
}

INT
swap2(prm, i, j)
INT             i, j;
OP              prm;
{
   INT             tp = S_P_II(prm, i);
   M_I_I(S_P_II(prm, j), S_P_I(prm, i));
   M_I_I(tp, S_P_I(prm, j));
   return OK;
}

INT
inter_one(v, w, prml, pds_base, pds_vrai, mes1, mes2, mes3, nb_coins, ind, res)
OP              v, w, res;
unsigned char  *prml, pds_base, pds_vrai, *mes1, *mes2, *mes3, nb_coins, ind;
{
   OP              mp = callocobject(), cp = callocobject(), res2 = callocobject();
   unsigned char   av, *bprml;
   unsigned char  *stock;
   int             i, j, h, k, n, nb;
   unsigned char  *btab, *baf, *bstock, *bboo, *boo, *bmes1, *bmes2, *bmes3;

   n = ordre + 1;
   stock = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   boo = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bboo = boo;
   bmes1 = mes1;
   bmes2 = mes2;
   bmes3 = mes3;
   for (i = 0; i < nb_coins; i++, bboo++, bmes1++, bmes2++, bmes3++)
   {
      nb = 0;
      btab = prml;
      for (j = 0; j < *bmes1; j++, btab++)
      {
	 if (n - (*btab) > *bmes2)
	    nb++;
      }
      if (nb == *bmes3)
	 *bboo = 1;
      else
	 *bboo = 0;
   }
   bprml = prml + ind - 1;
   if (ind != ordre - 1)
   {
      i = ind;
      j = i + 1;
      btab = prml + i;
      baf = prml + j;
      bstock = stock;
      for (; j <= ordre - 1; j++, baf++)
      {
	 if (*baf > *btab)
	 {
	    if (*baf > *bprml)
	    {
	       *bstock++ = j;
	       av = *baf;
	    } else
	       goto stade2;
	    break;
	 }
      }
      j++;
      baf++;
      for (; j <= ordre - 1; j++, baf++)
      {
	 if (*baf > *btab && *baf < av)
	 {
	    if (*baf > *bprml)
	    {
	       *bstock++ = j;
	       av = *baf;
	    } else
	       break;
	 }
      }

      k = bstock - stock;
      if (k != 0)
	 bstock--;
      for (; k > 0; k--, bstock--)
      {
	 j = *bstock;
	 bboo = boo;
	 bmes1 = mes1;
	 bmes2 = mes2;
	 baf = prml + j;
	 btab = prml + i;
	 for (h = 0; h < nb_coins; h++, bboo++, bmes1++, bmes2++)
	 {
	    if (*bboo == 1 && i < *bmes1 && j >= *bmes1 && (n - *baf) <= *bmes2 && (n - *btab) > *bmes2)
	       break;
	 }

	 if (h == nb_coins)
	 {
	    b_skn_mp(callocobject(), callocobject(), NULL, mp);
	    M_I_I(1L, S_PO_S(mp));
	    M_I_I(-1L, S_PO_K(mp));
	    if (pds_vrai <= pds_base + 3)
	       add_apply(mp, res);
	    else
	    {
	       OP              sp = callocobject();
	       copy(v, cp);
	       swap2(cp, i, j);
	       calcul_tr(cp, w, res2);
	       mult(res2, mp, sp);
	       add_apply(sp, res);
	       SYMfreeall(sp);
	    }
	    freeself(mp);
	 }			/* End of if(h==nb_coins) */
      }				/* End of for(k;k>0;... */

   }				/* End of if(ind !=ordre-1) */
stade2:bprml++;
   if (ind != 1)
   {
      i = ind - 1;
      j = i - 1;
      btab = prml + i;
      baf = prml + j;
      bstock = stock;
      for (; j >= 0; j--, baf--)
      {
	 if (*baf < *btab)
	 {
	    if (*baf < *bprml)
	    {
	       *bstock++ = j;
	       av = *baf;
	    } else
	    {
	       SYM_free((char *) stock);
	       SYM_free((char *) boo);
	       SYMfreeall(mp);
	       SYMfreeall(cp);
	       SYMfreeall(res2);
	       return OK;
	    }
	    break;
	 }
      }
      j--;
      baf--;
      for (; j >= 0; j--, baf--)
      {
	 if (*baf < *btab && *baf > av)
	 {
	    if (*baf < *bprml)
	    {
	       *bstock++ = j;
	       av = *baf;
	    } else
	       break;
	 }
      }

      k = bstock - stock;
      if (k != 0)
	 bstock--;
      for (; k > 0; k--, bstock--)
      {
	 j = *bstock;
	 bboo = boo;
	 bmes1 = mes1;
	 bmes2 = mes2;
	 baf = prml + i;
	 btab = prml + j;
	 for (h = 0; h < nb_coins; h++, bboo++, bmes1++, bmes2++)
	 {
	    if (*bboo == 1 && j < *bmes1 && i >= *bmes1 && (n - *baf) <= *bmes2 && (n - *btab) > *bmes2)
	       break;
	 }

	 if (h == nb_coins)
	 {
	    b_skn_mp(callocobject(), callocobject(), NULL, mp);
	    M_I_I(1L, S_PO_S(mp));
	    M_I_I(-1L, S_PO_K(mp));
	    /*
	     * printf("GGG\n"); copy(v,cp); swap2(cp, i, j); println(cp);
	     */
	    if (pds_vrai <= pds_base + 3)
	       add_apply(mp, res);
	    else
	    {
	       OP              sp = callocobject();
	       copy(v, cp);
	       swap2(cp, i, j);
	       calcul_tr(cp, w, res2);
	       mult(res2, mp, sp);
	       add_apply(sp, res);
	       SYMfreeall(sp);
	    }
	    freeself(mp);
	 }			/* End of if(h==nb_coins) */
      }				/* End of for(k;k>0;... */
   }
   /* End of if(ind!=1) */

   SYM_free(stock);
   SYM_free((char *) boo);

   SYMfreeall(mp);
   SYMfreeall(cp);
   SYMfreeall(res2);
   return OK;
}


/*
 * Returns 0 if the permutation is bigger than the rectrices of the initial
 * permutation. Returns 1, if not.
 */

int
flt_rct(bcumul, bcumul_av, bcum, ind_col, y, lim, nb, nb_col)
unsigned char  *bcumul, *bcumul_av, *bcum, y, lim, nb, nb_col;
signed char     ind_col;
{
   int             i = nb_col - 1;
   unsigned char   tmp = 0;

   for (; i > ind_col; i--, bcumul_av--, bcum--)
   {
      if (*bcum + *bcumul_av <= lim)
	 return 1;
      if (*bcum >= lim)
	 tmp += *bcumul_av;
      else
	 tmp += *bcum + *bcumul_av - lim;
      if (tmp >= nb)
	 return 0;
   }

   if (*bcum + y <= lim)
      return 1;
   if (*bcum >= lim)
      tmp += y;
   else
      tmp += *bcum + y - lim;
   if (tmp >= nb)
      return 0;

   bcum--;
   i--;
   for (; i >= 0; i--, bcum--, bcumul--)
   {
      if (*bcum + *bcumul <= lim)
	 return 1;
      if (*bcum >= lim)
	 tmp += *bcumul;
      else
	 tmp += *bcum + *bcumul - lim;
      if (tmp >= nb)
	 return 0;
   }
   return 1;
}

/*
 * Returns the y the maximal part which is possible, according with the
 * initial permutation.
 */

int
tst_rct(bmes1, bmes2, bmes3, nb_coins, place, y, bcumul, bcum, bcumul_av, ind_col, nb_col)
unsigned char  *bmes1, *bmes2, *bmes3, nb_coins, place, y;
unsigned char  *bcumul, *bcum, *bcumul_av, nb_col;
signed char     ind_col;
{
   int             i;
   for (i = 0; i < nb_coins; i++, bmes1++, bmes2++, bmes3++)
   {
      if (place < *bmes1 && place + y >= *bmes1)
      {
	 if (flt_rct(bcumul, bcumul_av + nb_col - ind_col - 1, bcum, ind_col,
		  *bcumul_av + *bmes1 - place, *bmes2, *bmes3, nb_col) == 1)
	 {
	    y = *bmes1 - place - 1;
	    if (y == 0)
	       return 0;
	 }
      }
   }
   return y;
}

/*
 * Returns the maximal part y which is possible according with the initial
 * permutation, for the last line.
 */

int
tst_rct_bis(bmes1, bmes2, bmes3, nb_coins, place, y, bcumul, bcum, bcumul_av, ind_col, nb_col)
unsigned char  *bmes1, *bmes2, *bmes3, nb_coins, place, y;
unsigned char  *bcumul, *bcum, *bcumul_av, nb_col;
signed char     ind_col;
{
   int             i;
   for (i = 0; i < nb_coins; i++, bmes1++, bmes2++, bmes3++)
   {
      if (place < *bmes1 && place + y >= *bmes1)
      {
	 if (flt_rct(bcumul, bcumul_av + nb_col - ind_col - 1, bcum, ind_col,
		  *bcumul_av + *bmes1 - place, *bmes2, *bmes3, nb_col) == 1)
	 {
	    return 0;
	 }
      }
   }
   return y;
}

/*
 * Returns 0 if the permutation is lower than the rectrices of the initial
 * permutation. Returns 1, if not.
 */

int
flt_rct_high(bcumul, bcumul_av, bcum, ind_col, y, lim, nb, nb_col)
unsigned char  *bcumul, *bcumul_av, *bcum, y, lim, nb, nb_col;
signed char     ind_col;
{
   int             i = 0;
   unsigned char   tmp = 0;

   for (; i < ind_col; i++, bcumul++, bcum--)
   {
      if (*bcum <= lim)
	 return 1;
      if (*bcum - *bcumul >= lim)
	 tmp += *bcumul;
      else
	 tmp += *bcum - lim;
      if (tmp >= nb)
      {
	 return 0;
      }
   }

   if (*bcum <= lim)
      return 1;
   if (*bcum - y >= lim)
      tmp += y;
   else
      tmp += *bcum - lim;
   if (tmp >= nb)
   {
      return 0;
   }
   bcum--;
   i++;

   for (; i < nb_col; i++, bcum--, bcumul_av++)
   {
      if (*bcum <= lim)
	 return 1;
      if (*bcum - *bcumul_av >= lim)
	 tmp += *bcumul_av;
      else
	 tmp += *bcum - lim;
      if (tmp >= nb)
      {
	 return 0;
      }
   }
   return 1;
}

/*
 * Returns 0 if the permutation is not  bigger than  than the initial
 * permutation
 */

int
tst_rct_high(bses1, bses2, bses3, nb_cs, place, y, bcumul, bcum, bcumul_av, ind_col, nb_col)
unsigned char  *bses1, *bses2, *bses3, nb_cs, place, y;
unsigned char  *bcumul, *bcum, *bcumul_av, nb_col;
signed char     ind_col;
{
   int             i;
   for (i = 0; i < nb_cs; i++, bses1++, bses2++, bses3++)
   {
      if (place < *bses1 && place + y >= *bses1)
      {
	 if (flt_rct_high(bcumul, bcumul_av + 1, bcum, ind_col,
		  *bcumul_av + *bses1 - place, *bses2, *bses3, nb_col) == 1)
	 {
	    return 0;
	 }
      }
   }
   return y;
}


/*
 * Returns 0 if p1 and p2 are equal 1 if not
 */

int
cmp_prm(p1, p2)
unsigned char  *p1, *p2;
{
   register int    i = 0;
   for (; i < ordre; i++, p1++, p2++)
      if (*p1 != *p2)
	 return 1;
   return 0;
}

/*
 * generates an interval of normalized permutations prm containing all
 * permutations bigger of prml and less than prmh for Bruhat order and such
 * that prm[ind]>prm[ind+1]
 */

int
inter_kl(v, w, way, wh, boo, ind, barr, res)
unsigned char   boo, barr;
int             ind;
OP              v, w, way, res;
INT             wh;
{
   unsigned char   indice, indice_col, av;
   unsigned char   nb_lgn, *lgn, **tb, nb_col, *col, **tb_cumul, **tb_cumul2;
   unsigned char  *tb_lgn_cumul, *tb_lgn_cumul2, *bcumul, *bcumul2, *bcumul_av;
   unsigned char  *tb_lgn, tmp, *blgn, *zero, place;
   unsigned char   recul, *bcol, nb, **bb, **bh;
   unsigned char   av2, *baf, *bs, *tb_lgn_bh, *bcum;
   signed char     ind_col, ind_lgn;
   unsigned char  *prm_gen, *col_cum, *col_cum_ret, tp;
   unsigned char  *bas, y, *bbh;
   unsigned char   pds_crt, pds, *prm1_gen, *prmh1, bl;
   unsigned char  *prml, *prmh, pds_base, bool, pds_vrai;
   unsigned char   nb_coins, *mes1, *mes2, *mes3, *bmes1, *bmes2, *bmes3;
   unsigned char   nb_cs, *ses1, *ses2, *ses3;
   OP              z, ld, tsp, mp, res1, res2;
   int             i, j;
   struct lst_rct *lstl, *lsth, *blst, *lst_gen;

   init(MONOPOLY, res);
   prml = t_p_uchar(v);
   prmh = t_p_uchar(w);
   pds_vrai = pds_prm(prmh);
   pds_base = pds_prm(prml);
   prmh1 = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   cpl(prmh, prmh1);
   nb_coins = rct(prmh1, &lsth);
   bmes1 = mes1 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes2 = mes2 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes3 = mes3 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));

   blst = lsth;
   while (blst != NULL)
   {
      *bmes1++ = blst->rct[0] + blst->rct[1];
      *bmes2++ = blst->rct[0] + blst->rct[2];
      *bmes3++ = blst->rct[1];
      blst = blst->nxt;
   }
   inter_one(v, w, prml, pds_base, pds_vrai, mes1, mes2, mes3, nb_coins, ind, res);

   if (pds_vrai == pds_base + 2)
   {
      SYM_free(mes1);
      SYM_free(mes2);
      SYM_free(mes3);
      SYM_free(prml);
      SYM_free(prmh);
      SYM_free(prmh1);
      free_lst_rct(lsth);
      return OK;
   }
   if (pds_vrai == pds_base + 3)
   {
      if (barr != 0)
      {
	 mp = callocobject();
	 b_skn_mp(callocobject(), callocobject(), NULL, mp);
	 M_I_I(barr, S_PO_S(mp));
	 M_I_I(-1L, S_PO_K(mp));
	 add_apply(mp, res);
	 SYMfreeall(mp);
      }
      SYM_free(prml);
      SYM_free(prmh);
      SYM_free(prmh1);
      SYM_free(mes1);
      SYM_free(mes2);
      SYM_free(mes3);
      free_lst_rct(lsth);
      return OK;
   }
   nb_cs = rct(prml, &lstl);
   bmes1 = ses1 = (unsigned char *) SYM_malloc(nb_cs * sizeof(unsigned char));
   bmes2 = ses2 = (unsigned char *) SYM_malloc(nb_cs * sizeof(unsigned char));
   bmes3 = ses3 = (unsigned char *) SYM_malloc(nb_cs * sizeof(unsigned char));
   blst = lstl;
   while (blst != NULL)
   {
      *bmes1++ = blst->rct[0] + blst->rct[1];
      *bmes2++ = blst->rct[0] + blst->rct[2];
      *bmes3++ = blst->rct[1];
      blst = blst->nxt;
   }

   z = callocobject();
   m_il_p(ordre, z);
   mp = callocobject();
   ld = callocobject();
   tsp = callocobject();
   res1 = callocobject();
   res2 = callocobject();
   prm1_gen = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   build_01(prml, &nb_lgn, &lgn, &tb, &nb_col, &col, &tb_cumul, &tb_cumul2);

   av = *lgn;
   blgn = lgn + 1;
   if (av == ind)
      indice = 1;
   else
   {
      for (i = 2; i < nb_lgn; i++)
      {
	 av += *blgn++;
	 if (av == ind)
	 {
	    indice = i;
	    break;
	 }
	 if (i == nb_lgn)
	    indice = 0;
      }
   }
   if (indice)
   {
      bas = tb[indice - 1];
      for (i = 0; i < nb_col; i++, bas++)
      {
	 if (*bas)
	    indice_col = i;
      }
   }
   ind_lgn = nb_lgn - 2;
   zero = (unsigned char *) SYM_calloc(nb_col, sizeof(unsigned char));
   col_cum = (unsigned char *) SYM_malloc((nb_col + 1) * sizeof(unsigned char));
   col_cum_ret = (unsigned char *) SYM_malloc((nb_col + 1) * sizeof(unsigned char));
   prm_gen = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   build_col_cum(col, &col_cum, &col_cum_ret, nb_col);

   pds_crt = 0;
   bh = tb;
   bb = tb_cumul2;
   place = 0;
   for (i = 0; i < nb_lgn - 1; i++, bh++, bb++)
   {
      if (i == indice)
	 break;
      baf = *bh + 1;
      bcol = col_cum + 1;
      bs = *bb;
      place += **bh;
      for (j = 1; j < nb_col; j++, baf++, bcol++, bs++)
	 if (*baf)
	 {
	    pds_crt += (*baf) * (*bcol - *bs);
	    place += *baf;
	 }
   }

   if ((pds_vrai - pds_base) % 2 == 0)
      pds = pds_vrai - 1;
   else
      pds = pds_vrai - 2;
   recul = 0;
   ind_lgn = indice;

   /*
    * voirbf(prml); voirbf(prmh); printf("ind %d, indice %d indice_col %d
    * place %d \n", ind, indice, indice_col, place); view_01(tb, nb_lgn,
    * nb_col);
    */

   while (ind_lgn >= 0)
   {
      /*
       * ct++; printf("ind_lgn %d \n", ind_lgn); view_01(tb, nb_lgn, nb_col);
       * if(ct==88) exit(0);
       */
      if (ind_lgn != nb_lgn - 1)
      {
	 tb_lgn = *(tb + ind_lgn);
	 tb_lgn_cumul = *(tb_cumul + ind_lgn);
	 tb_lgn_cumul2 = *(tb_cumul2 + ind_lgn);
	 if (recul == 1)
	 {
	    ind_col = nb_col - 2;
	    tmp = *(tb_lgn + ind_col + 1);
	    pds_crt -= *(tb_lgn + ind_col + 1) * (*(col_cum + ind_col + 1) - *(tb_lgn_cumul2 + ind_col));
	    place -= tmp;
	 } else
	 {
	    tmp = lgn[ind_lgn];
	    ind_col = 0;
	    av2 = 0;
	    bcumul_av = *(tb_cumul + ind_lgn - 1);
	    bcumul = tb_lgn_cumul;
	    blgn = tb_lgn;
	    bcumul2 = tb_lgn_cumul2;
	    if (ind_lgn && indice == ind_lgn)
	    {
	       for (; ind_col < indice_col; ind_col++, blgn++, bcumul++, bcumul_av++, bcumul2++)
	       {
		  *bcumul = *bcumul_av;
		  *bcumul2 = *bcumul + av2;
		  *blgn = 0;
		  av2 = *bcumul2;
	       }
	       bcum = col_cum + ind_col + 1;
	       bcol = col + ind_col;
	    }
	    /* End of if(ind_lgn && indice==ind_lgn) */
	    else
	    {
	       bcum = col_cum + 1;
	       bcol = col;
	    }
	 }			/* End of else of if(recull==1) */

	 while (ind_col >= 0)
	 {
	    if (recul == 1)
	    {
	       blgn = tb_lgn + ind_col;
	       while (ind_col >= 0 && *blgn == 0)
	       {
		  blgn--;
		  ind_col--;
	       }
	       if (ind_col == nb_col - 1)
	       {
		  ind_col = nb_col - 2;
		  pds_crt -= (*blgn) * (*(col_cum + ind_col + 1) - *(tb_lgn_cumul2 + ind_col));
		  tmp += *blgn;
		  place -= *blgn;
		  continue;
	       }
	       if (ind_col < 0)
		  break;

	       /*
	        * Good test but too long. if(ind_col!=0){
	        * if(pds_crt+(tmp+1)*(*(col_cum+ind_col+1)-
	        * (tb_lgn_cumul2+ind_col))- *(col_cum+ind_col)+
	        * (tb_lgn_cumul2+ind_col-1) > pds){ ind_col--; pds_crt-= blgn
	        * *(*(col_cum+ind_col+1)- *(tb_lgn_cumul2+ind_col));
	        * 
	        * tmp+= *blgn; place-= *blgn; continue; } } else{
	        * if(pds_crt+(tmp+1)*(*(col_cum+1)- *(tb_lgn_cumul2)) > pds){
	        * ind_col--; place-= *blgn; continue; } }
	        */
	       tmp++;
	       place--;
	       bcumul = tb_lgn_cumul + ind_col;
	       bcumul2 = tb_lgn_cumul2 + ind_col;
	       if (ind_col != 0)
	       {
		  pds_crt -= *(col_cum + ind_col) - *(bcumul2 - 1);
	       }
	       (*bcumul)--;
	       (*blgn)--;
	       (*bcumul2)--;
	       av2 = *bcumul2;
	       ind_col++;
	       blgn++;
	       bcumul++;
	       bcumul2++;
	       bcol = col + ind_col;
	       if (ind_lgn == 0)
	       {
		  bcumul_av = zero;
	       } else
	       {
		  bcumul_av = *(tb_cumul + ind_lgn - 1) + ind_col;
	       }
	       recul = 0;
	       bcum = col_cum + ind_col + 1;
	    }
	    /* End of if(recul==1) */
	    else
	    {
	       nb = *bcol - *bcumul_av;
	       if (nb == 0)
	       {
		  *bcumul = *bcumul_av;
		  *bcumul2 = *bcumul + av2;
		  *blgn = 0;
		  av2 = *bcumul2;
	       }
	       /* End of if (nb==0) */
	       else
	       {

		  y = (tmp < nb) ? tmp : nb;
		  y = tst_rct(ses1, ses2, ses3, nb_cs, place, y, bcumul - 1, col_cum + nb_col - 1, bcumul_av, ind_col, nb_col);


		  if (y == 0)
		  {
		     *bcumul = *bcumul_av;
		     *bcumul2 = *bcumul + av2;
		     *blgn = 0;
		     av2 = *bcumul2;
		  }
		  /* End of if (y==0) */
		  else
		  {

		     if (tst_rct_high(mes1, mes2, mes3, nb_coins, place, y, tb_lgn_cumul, col_cum_ret + nb_col, bcumul_av, ind_col, nb_col) == 0)
		     {
			ind_col--;
			recul = 1;
			continue;
		     }
		     if (ind_col != 0)
			tp = *(bcum - 1) - *(bcumul2 - 1);
		     else
			tp = 0;


		     /*
		      * Good test but too long if(tmp<=y){
		      * 
		      * if(pds_crt+tmp*tp > pds){ recul=1; ind_col--; continue;
		      * } } else{ if(pds_crt+(
		      * bcum-(*bcumul_av+y+av2))*(tmp-y)+y*tp >pds){ recul=1;
		      * ind_col--; continue; } }
		      * 
		      */

		     if (tmp <= y)
		     {
			*blgn = tmp;
			*bcumul = *bcumul_av + tmp;
			*bcumul2 = *bcumul + av2;
			pds_crt += tmp * tp;
			place += tmp;
			av2 = *bcumul2;
			tmp = 0;
			if (ind_lgn + 1 == indice)
			   indice_col = ind_col;
			bcumul_av++;
			ind_col++;
			blgn++;
			bcumul++;
			bcumul2++;
			for (; ind_col < nb_col; ind_col++, blgn++, bcumul++, bcumul_av++, bcumul2++)
			{
			   *bcumul = *bcumul_av;
			   *bcumul2 = *bcumul + av2;
			   *blgn = 0;
			   av2 = *bcumul2;
			}
			break;
		     }
		     /* End of if(tmp<=nb) */
		     else
		     {
			pds_crt += y * tp;
			place += y;
			*blgn = y;
			*bcumul = *bcumul_av + y;
			tmp -= y;
			*bcumul2 = *bcumul + av2;
			av2 = *bcumul2;
		     }		/* End of else of if(tmp<=y) */
		  }		/* End of else of if(y==0) */
	       }		/* End of else of if(nb==0) */

	       bcumul++;
	       bcumul2++;
	       blgn++;
	       bcum++;
	       ind_col++;
	       bcol++;
	       bcumul_av++;

	       if (ind_col == nb_col)
	       {
		  recul = 1;
		  ind_col--;
	       }
	    }			/* End of else of if(recul==1) */

	 }			/* End of while(ind_col>=0) */

	 if (ind_col == -1)
	    ind_lgn--;
	 else
	    ind_lgn++;

      }
      /* End of if (ind_lgn!= nb_lgn-1) */
      else
      {
	 if ((pds_crt - pds_base) % 2 == 0 || pds_crt - pds_base == 1)
	 {
	    recul = 1;
	    ind_lgn--;
	    continue;
	 }
	 bcumul_av = *(tb_cumul + nb_lgn - 2);
	 blgn = *(tb + nb_lgn - 1);
	 bcol = col;

	 av = 0;
	 bl = 0;
	 if (indice != ind_lgn)
	 {

	    bcumul_av = *(tb_cumul + nb_lgn - 2);
	    blgn = *(tb + nb_lgn - 1);
	    bcol = col;
	    for (i = 0; i < nb_col; i++, bcol++, bcumul_av++, blgn++)
	    {
	       y = *bcol - *bcumul_av;
	       if (y != 0)
	       {
		  if (tst_rct_bis(ses1, ses2, ses3, nb_cs, place, y, bcol - 1, col_cum + nb_col - 1, bcumul_av, i, nb_col) == 0)
		     break;
		  if (tst_rct_high(mes1, mes2, mes3, nb_coins, place, y, col, col_cum_ret + nb_col, bcumul_av, i, nb_col) == 0)
		     break;
	       }
	       *blgn = y;
	       place += y;
	    }
	    place = ordre - lgn[ind_lgn];
	    recul = 1;
	    ind_lgn--;
	    if (i != nb_col)
	       continue;

	    t_01_prm(tb, tb_cumul, col_cum + 1, nb_col, nb_lgn, &prm_gen);
	    if (cmp_prm(prm_gen, prmh) == 0)
	       continue;
	    bl = 1;
	    /*
	     * printf("pds_crt %d\n", pds_crt); voirbf(prm_gen);
	     */


	    /*
	     * voirbf(prm_gen); rct(prm_gen, &lst_gen); view_rct(lst_gen);
	     * free_lst_rct(lst_gen);
	     */

	    cte++;
	 } else
	 {
	    for (i = 0; i < nb_col; i++, blgn++, bcol++, bcumul_av++)
	    {
	       *blgn = *bcol - *bcumul_av;
	       if (*blgn)
	       {
		  if (i < indice_col)
		  {
		     av = 1;
		  } else
		  {
		     blgn++;
		     bcol++;
		     i++;
		     bcumul_av++;
		  }
		  break;
	       }
	    }
	    if (av == 0)
	    {

	       for (; i < nb_col; i++, bcol++, bcumul_av++, blgn++)
	       {
		  y = *bcol - *bcumul_av;
		  if (y != 0)
		  {
		     if (tst_rct_bis(ses1, ses2, ses3, nb_cs, place, y, bcol - 1, col_cum + nb_col - 1, bcumul_av, i, nb_col) == 0)
			break;
		     if (tst_rct_high(mes1, mes2, mes3, nb_coins, place, y, col, col_cum_ret + nb_col, bcumul_av, i, nb_col) == 0)
			break;
		  }
		  *blgn = y;
		  place += y;
	       }
	       place = ordre - lgn[ind_lgn];
	       recul = 1;
	       ind_lgn--;
	       if (i != nb_col)
		  continue;

	       t_01_prm(tb, tb_cumul, col_cum + 1, nb_col, nb_lgn, &prm_gen);
	       if (cmp_prm(prm_gen, prmh) == 0)
		  continue;
	       bl = 1;

	       /*
	        * printf("pds_crt %d\n", pds_crt); voirbf(prm_gen);
	        */
	       /*
	        * voirbf(prm_gen); rct(prm_gen, &lst_gen); view_rct(lst_gen);
	        * free_lst_rct(lst_gen);
	        */

	       cte++;
	    }
	    /* End of if av==0) */
	    else
	    {
	       place = ordre - lgn[ind_lgn];
	       recul = 1;
	       ind_lgn--;
	    }

	 }			/* End of else of if(indice != ind_lgn */
	 if (bl == 1)
	 {
	    bool = 0;
	    t_uchar_p(prm_gen, z);
	    if (!EQ(w, z))
	       if (pds_crt != pds_base + 1)
	       {
		  if (boo == 1)
		     calculv(v, z, res1);
		  else
		     calculc(v, z, way, wh, res1);
		  if (S_O_K(res1) == MONOPOLY)
		  {
		     ld_coef(res1, tsp, ld);
		     if (S_I_I(ld) == (pds_crt - pds_base - 1) / 2)
		     {
			j = S_I_I(ld) + 1;
			bool = 1;
		     }
		  }
	       } else
	       {

		  j = 1;
		  bool = 1;
	       }

	    if (bool == 1)
	    {
	       /*
	        * printf("EEE\n"); println(z);
	        */

	       b_skn_mp(callocobject(), callocobject(), NULL, mp);
	       M_I_I(j, S_PO_S(mp));
	       M_I_I(-1L, S_PO_K(mp));

	       if (pds_crt + 2 >= pds_vrai)
	       {
		  add_apply(mp, res);
	       } else
	       {
		  OP              sp = callocobject();
		  calcul_tr(z, w, res2);
		  mult(res2, mp, sp);
		  add_apply(sp, res);
		  SYMfreeall(sp);
	       }
	       freeself(mp);

	    }
	 }			/* End of else of if(pds_crt!= pds_base +1) */
      }				/* End of if bl==1 */
   }				/* End of while (ind_lgn >=0) */

   if (barr != 0)
   {
      b_skn_mp(callocobject(), callocobject(), NULL, mp);
      M_I_I(barr, S_PO_S(mp));
      M_I_I(-1L, S_PO_K(mp));
      add_apply(mp, res);
      freeself(mp);
   }
   SYM_free(lgn);
   SYM_free(zero);
   SYM_free(prm_gen);
   SYM_free(col_cum);
   SYM_free(col);
   SYM_free(col_cum_ret);
   free2(tb, nb_lgn);
   free2(tb_cumul, nb_lgn);
   free2(tb_cumul2, nb_lgn);

   free_lst_rct(lstl);
   free_lst_rct(lsth);
   SYM_free(prm1_gen);
   SYM_free(prmh1);
   SYM_free(prml);
   SYM_free(prmh);
   SYMfreeall(res1);
   SYMfreeall(res2);
   SYMfreeall(z);
   SYMfreeall(ld);
   SYMfreeall(tsp);
   SYMfreeall(mp);
   SYM_free(mes1);
   SYM_free(mes2);
   SYM_free(mes3);
   SYM_free(ses1);
   SYM_free(ses2);
   SYM_free(ses3);
   /*
    * printf("_______________________\n");
    */
   return 0;
}

/*
 * views all the normalized permutations less than prml and upper than prmh
 */

INT
view_inter_nrm_pds(prml, prmh)
unsigned char  *prml, *prmh;
{
   return OK;
}

/*
 * Transforms a monopoly object into a vector object
 */

INT
m_mp_v(pol, res)
OP              pol, res;
{
   INT             max = 0;
   OP              z = pol;

   if (S_O_K(pol) == INTEGER)
   {
      m_il_nv(1L, res);
      M_I_I(S_I_I(pol), S_V_I(res, 0L));
      return OK;
   }
   if (S_O_K(pol) == MONOPOLY)
   {
      while (z != NULL)
      {
	 if (S_I_I(S_PO_S(z)) > max)
	    max = S_I_I(S_PO_S(z));
	 z = S_L_N(z);
      }
      m_il_nv(max + 1, res);
      z = pol;
      while (z != NULL)
      {
	 M_I_I(S_PO_KI(z), S_V_I(res, S_I_I(S_PO_S(z))));
	 z = S_L_N(z);
      }
      return OK;
   } else
   {
      copy(pol, res);
      return OK;
   }
}


/*
 * views all the normalized permutations upon the permutation prm new
 * algorithm
 */

INT
cell(oprm, li_prm, li_kl, fl)
OP              oprm, li_prm, li_kl;
INT             fl;
{

   unsigned char   nb_lgn, *lgn, **tb, nb_col, *col, **tb_cumul;
   unsigned char  *tb_lgn_cumul, *tb_lgn_cumul2, *bcumul, *bcumul_av;
   unsigned char  *tb_lgn, tmp, tmp_pal, *blgn, *zero;
   unsigned char   recul, *bcol, nb, **bb, **bh;
   unsigned char   av2, *baf, *bs, *tb_lgn_bh;
   signed char     ret, ind_col, ind_col_pal, ind_lgn;
   unsigned char  *prm_gen, *col_cum;
   unsigned char  *bas, y, *bbh;
   int             i, j;
   unsigned char  *prm, nb_coins;
   OP              oprm_gen, res, z, zk, oprm_res, kl_res, zav, zkav, cel;
   struct lst_rct *lst, *blst;
   unsigned char  *mes1, *bmes1, *mes2, *bmes2, *mes3, *bmes3, place;

   for (i = 0; i < ordre; i++)
      if (S_P_II(oprm, i) != i + 1)
	 break;
   if (i == ordre)
      return OK;

   for (i = 0; i < ordre; i++)
      if (S_P_II(oprm, i) != ordre - i)
	 break;
   if (i == ordre)
      return OK;

   oprm_gen = callocobject();
   m_il_p(ordre, oprm_gen);
   if (fl != 0)
   {
      res = callocobject();
   }
   prm = t_p_uchar(oprm);

   nb_coins = rct(prm, &lst);

   bmes1 = mes1 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes2 = mes2 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes3 = mes3 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));

   blst = lst;
   while (blst != NULL)
   {
      *bmes1++ = blst->rct[0] + blst->rct[1];
      *bmes2++ = blst->rct[0] + blst->rct[2];
      *bmes3++ = blst->rct[1];
      blst = blst->nxt;
   }

   build_01_el(prm, &nb_lgn, &lgn, &tb, &nb_col, &col, &tb_cumul);
   ind_lgn = nb_lgn - 2;
   place = ordre - lgn[ind_lgn + 1];
   zero = (unsigned char *) SYM_calloc(nb_col, sizeof(unsigned char));
   col_cum = (unsigned char *) SYM_malloc((nb_col + 1) * sizeof(unsigned char));
   prm_gen = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));

   baf = col_cum;
   *baf++ = 0;
   *baf++ = av2 = *col;
   bcol = col + 1;
   for (i = 1; i < nb_col; i++, baf++, bcol++)
   {
      *baf = *bcol + av2;
      av2 = *baf;
   }

   recul = 1;

   while (ind_lgn >= 0)
   {
      if (ind_lgn != nb_lgn - 1)
      {
	 tb_lgn = *(tb + ind_lgn);
	 tb_lgn_cumul = *(tb_cumul + ind_lgn);
	 if (recul == 1)
	 {
	    ind_col = nb_col - 2;
	    tmp = *(tb_lgn + ind_col + 1);
	    place -= tmp;
	 } else
	 {
	    bcol = col;
	    tmp = lgn[ind_lgn];
	    ind_col = 0;
	    bcumul_av = *(tb_cumul + ind_lgn - 1);
	    bcumul = tb_lgn_cumul;
	    blgn = tb_lgn;
	 }

	 while (ind_col >= 0)
	 {
	    if (recul == 1)
	    {
	       blgn = tb_lgn + ind_col;
	       while (ind_col >= 0 && *blgn == 0)
	       {
		  blgn--;
		  ind_col--;
	       }
	       if (ind_col == nb_col - 1)
	       {
		  ind_col = nb_col - 2;
		  tmp += *blgn;
		  place -= *blgn;
		  continue;
	       }
	       if (ind_col < 0)
		  break;
	       place--;
	       tmp++;
	       bcumul = tb_lgn_cumul + ind_col;
	       (*bcumul)--;
	       (*blgn)--;
	       ind_col++;
	       blgn++;
	       bcumul++;
	       bcol = col + ind_col;
	       if (ind_lgn == 0)
	       {
		  bcumul_av = zero;
	       } else
	       {
		  bcumul_av = *(tb_cumul + ind_lgn - 1) + ind_col;
	       }
	       recul = 0;
	    }
	    /* End of if(recul==1) */
	    else
	    {
	       nb = *bcol - *bcumul_av;
	       if (nb == 0)
	       {
		  *bcumul = *bcumul_av;
		  *blgn = 0;
	       }
	       /* End of if (nb==0) */
	       else
	       {
		  y = (tmp < nb) ? tmp : nb;
		  y = tst_rct(mes1, mes2, mes3, nb_coins, place, y, bcumul - 1,
			  col_cum + nb_col - 1, bcumul_av, ind_col, nb_col);
		  if (y == 0)
		  {
		     *bcumul = *bcumul_av;
		     *blgn = 0;
		  }
		  /* End of if (y==0) */
		  else
		  {
		     if (tmp <= y)
		     {
			*blgn = tmp;
			place += tmp;
			*bcumul = *bcumul_av + tmp;
			tmp = 0;
			bcumul_av++;
			ind_col++;
			blgn++;
			bcumul++;
			for (; ind_col < nb_col; ind_col++, blgn++, bcumul++, bcumul_av++)
			{
			   *bcumul = *bcumul_av;
			   *blgn = 0;
			}
			break;
		     }
		     /* End of if(tmp<=nb) */
		     else
		     {
			*blgn = y;
			place += y;
			*bcumul = *bcumul_av + y;
			tmp -= y;
		     }		/* End of else of if(tmp<=y) */
		  }		/* End of else of if(y==0) */
	       }		/* End of else of if(nb==0) */

	       bcumul++;
	       blgn++;
	       ind_col++;
	       bcol++;
	       bcumul_av++;

	       if (ind_col == nb_col)
	       {
		  recul = 1;
		  ind_col--;
	       }
	    }			/* End of else of if(recul==1) */

	 }			/* End of while(ind_col>=0) */

	 if (ind_col == -1)
	    ind_lgn--;
	 else
	    ind_lgn++;

      }
      /* End of if (ind_lgn!= nb_lgn-1) */
      else
      {

	 bcumul_av = *(tb_cumul + nb_lgn - 2);
	 blgn = *(tb + nb_lgn - 1);
	 bcol = col;
	 for (i = 0; i < nb_col; i++, bcol++, bcumul_av++, blgn++)
	 {
	    y = *bcol - *bcumul_av;
	    if (y != 0)
	    {
	       if (tst_rct_bis(mes1, mes2, mes3, nb_coins, place, y, bcol - 1, col_cum + nb_col - 1, bcumul_av, i, nb_col) == 0)
		  break;
	    }
	    *blgn = y;
	    place += y;
	 }
	 place = ordre - lgn[ind_lgn];
	 recul = 1;
	 ind_lgn--;
	 if (i != nb_col)
	    continue;

	 /*
	  * view_01(tb, nb_lgn, nb_col);
	  */
	 t_01_prm(tb, tb_cumul, col_cum + 1, nb_col, nb_lgn, &prm_gen);


	 cte++;
	 t_uchar_p(prm_gen, oprm_gen);
	 if (fl == 0)
	 {
	    oprm_res = callocobject();
	    copy(oprm_gen, oprm_res);
	    if (empty_listp(li_prm))
	    {
	       c_l_s(li_prm, oprm_res);
	    } else
	       insert_list(oprm_res, li_prm, NULL, NULL);
	 } else
	 {
	    if (fl != 3)
	       calculm(oprm, oprm_gen, res);	/* CC 050998 */
	    if (fl == 1 || (fl == 2 && not einsp(res)) 
		|| (fl == 3))
	    {
	       oprm_res = callocobject();
	       copy(oprm_gen, oprm_res);
	       if (fl != 3)
	       {
		  kl_res = callocobject();
		  m_mp_v(res, kl_res);
	       }
	       if (empty_listp(li_prm))
	       {
		  if (fl == 3)
		  {
		     calculm(oprm, oprm_gen, res);	/* CC 050998 */
		     if (not einsp(res))	
		     {
			kl_res = callocobject();
			m_mp_v(res, kl_res);
		     } else
			SYMfreeall(oprm_res);
		  }
		  if (fl != 3 || (fl == 3 && not einsp(res)))
		  {
		     c_l_s(li_prm, oprm_res);
		     c_l_s(li_kl, kl_res);
		     zav = li_prm;
		     zkav = li_kl;
		  }
	       } else if (fl == 1 || (fl == 2 && not einsp(res)))

	       {
		  cel = callocobject();
		  init(SYMLIST, cel);
		  C_L_S(cel, oprm_res);
		  C_L_N(zav, cel);
		  zav = cel;
		  cel = callocobject();
		  init(SYMLIST, cel);
		  C_L_S(cel, kl_res);
		  C_L_N(zkav, cel);
		  zkav = cel;
	       } else
	       {
		  z = li_prm;
		  zk = li_kl;
		  while (z != NULL)
		  {
		     ret = bruhat_comp_perm(oprm_res, S_L_S(z));
		     if (ret == 1)
		     {
			SYMfreeall(oprm_res);
			break;
		     }
		     if (ret == -1)
		     {
			SYMfreeall(S_L_S(z));
			SYMfreeall(S_L_S(zk));
			C_L_S(z, oprm_res);
			printf("HORROR\n");
			exit(1);
		     }
		     zav = z;
		     zkav = zk;
		     z = S_L_N(z);
		     zk = S_L_N(zk);
		  }
		  if (z == NULL)
		  {
		     calculm(oprm, oprm_gen, res);	/* CC 050998 */
		     if (not einsp(res))
		     {
			kl_res = callocobject();
			m_mp_v(res, kl_res);
			cel = callocobject();
			init(SYMLIST, cel);
			C_L_S(cel, oprm_res);
			C_L_N(zav, cel);
			cel = callocobject();
			init(SYMLIST, cel);
			C_L_S(cel, kl_res);
			C_L_N(zkav, cel);
		     } else
			SYMfreeall(oprm_res);
		  }
	       }
	    }
	    freeself(res);
	 }
	 freeself(oprm_gen);
	 m_il_p(ordre, oprm_gen);
      }				/* End of else of if (ind_lgn!= nb_lgn-1) */

   }				/* End of while(ind_lgn>=0 && ind_lgn <
				 * nb_lgn) */

   SYM_free(lgn);
   SYM_free(zero);
   SYM_free(prm_gen);
   SYM_free(col_cum);

   SYM_free(col);
   free2(tb, nb_lgn);
   free2(tb_cumul, nb_lgn);
   SYM_free(mes1);
   SYM_free(mes2);
   SYM_free(mes3);
   SYM_free(prm);
   free_lst_rct(lst);
   SYMfreeall(oprm_gen);
   if (fl != 0)
   {
      SYMfreeall(res);
   }
   return OK;
}

/*
 * Returns in vc the normalized permutations upon prm
 */

INT
upper_prm_ls(prm, vc)
OP              prm, vc;
{
   OP              li_prm = callocobject();
   init(SYMLIST, li_prm);
   ordre=S_P_LI(prm);
   cell(prm, li_prm, NULL, 0);
   if (S_L_S(li_prm) == NULL)
   {
      m_il_nv(1L, vc);
   } else
   {
      t_LIST_VECTOR(li_prm, vc);
   }
   SYMfreeall(li_prm);
   return OK;
}

/*
Returns in vc the normalized permutations below prm
*/

INT lower_prm (OP prm, OP vc){
	OP prm1, vc1;
	if (!EMPTYP(vc)) freeself(vc);
	prm1=callocobject();
	vc1=callocobject();
	reverse_prm(prm, prm1);
	upper_prm_ls(prm1, vc1);
	reverse_prm_vc(vc1, vc);
	SYMfreeall(vc1); SYMfreeall(prm1);
	return OK;	
}

/*
 * Returns 1 if the KL polynomial vc has a maximal degree 0 if not
 */

INT
kl_max(prm1, prm2, vc)
OP              prm1, prm2, vc;
{
   OP              nb1 = callocobject(), nb2 = callocobject();
   numberof_inversionen(prm1, nb1);
   numberof_inversionen(prm2, nb2);
   if ((S_I_I(nb2) - S_I_I(nb1) - 1) / 2 == S_V_LI(vc) - 1)
   {
      SYMfreeall(nb1);
      SYMfreeall(nb2);
      return 1L;
   } else
   {
      SYMfreeall(nb1);
      SYMfreeall(nb2);
      return 0L;
   }
}

INT filter(OP prm, OP vc_prm1, OP vc_kl1, INT (*f)(OP, OP, OP), OP vc_prm, OP vc_kl){
	OP cell1, cell2, z1, z2, a, b;
	INT i;
	OP li_prm, li_kl;

	li_prm=callocobject();
	li_kl=callocobject();
	init(SYMLIST, li_prm); init(SYMLIST, li_kl);
	z1=li_prm; z2=li_kl;
	for(i=0; i<S_V_LI(vc_prm1); i++){
		if(f(prm, S_V_I(vc_prm1, i), S_V_I(vc_kl1, i))==1L){
			cell1=callocobject(); cell2=callocobject();
			init(SYMLIST, cell1); init(SYMLIST, cell2);
			a=callocobject(); b=callocobject();
			copy(S_V_I(vc_prm1, i), a); copy(S_V_I(vc_kl1, i), b);
			C_L_S(cell1, a); C_L_S(cell2, b);
			C_L_N(z1, cell1); C_L_N(z2, cell2);
			z1=cell1; z2=cell2;
		}
	}
	if(S_L_N(li_prm)!= NULL){
		t_LIST_VECTOR(S_L_N(li_prm), vc_prm);
		t_LIST_VECTOR(S_L_N(li_kl), vc_kl);
	}
	SYMfreeall(li_prm); SYMfreeall(li_kl);
	return OK;
}

INT filter_vc( vc_kl, vc_klf)
OP  vc_kl, vc_klf;
{
	OP  cell2,z2, b, z;
	INT i;
	OP  li_kl;

	li_kl=callocobject();
	init(SYMLIST, li_kl);
	 z2=li_kl;
	for(i=0; i<S_V_LI(vc_kl); i++){
		z=S_L_N(li_kl);
		while(z!=NULL){
			if(comp(S_L_S(z), S_V_I(vc_kl,i))==0L)
			{
				break;
			}
			z=S_L_N(z);
		}
		if(z==NULL){
			cell2=callocobject();
			init(SYMLIST, cell2);
			b=callocobject();
			copy(S_V_I(vc_kl, i), b);
			C_L_S(cell2, b);
			C_L_N(z2, cell2);
			z2=cell2;
		}
	}
	t_LIST_VECTOR(S_L_N(li_kl), vc_klf);
	SYMfreeall(li_kl);
	return OK;
}

/*
Input: prm a permutation.
Output: vc_prm, vc_kl
Computes the KL polynom of maximal degree Convention LS;
*/

INT upper_kl_max_ls (OP prm, OP  vc_prm, OP vc_kl){
	OP vc_kl1=callocobject(), vc_prm1=callocobject();
	if (not EMPTYP(vc_kl)) freeself(vc_kl);
	if (not EMPTYP(vc_prm)) freeself(vc_prm);
	ordre=S_P_LI(prm);
	upper_kl_ls(prm, vc_prm1, vc_kl1);
	filter(prm, vc_prm1, vc_kl1, kl_max, vc_prm, vc_kl);
	SYMfreeall(vc_kl1); SYMfreeall(vc_prm1);
	return 0L;
}

/*
 * Returns in vc_prm the normalized permutations p below prm for which the
 * Kaszhdan-Lutszig polynom P_{p}(prm) has a maximal degree. In vc_kl, there
 * are the P_{p}(prm).
 */

INT  lower_kl_max(OP prm, OP vc_prm, OP vc_kl)
{
	OP prm1=callocobject(), vc_prm1=callocobject();
	if (!EMPTYP(vc_prm)) freeself(vc_prm);
	if (!EMPTYP(vc_kl)) freeself(vc_kl);
	reverse_prm(prm, prm1);
	upper_kl_max_ls(prm1, vc_prm1, vc_kl);
	reverse_prm_vc(vc_prm1, vc_prm);
	SYMfreeall(vc_prm1); SYMfreeall(prm1);
	return OK;
}

/*
 * Returns in vc_prm the normalized permutations p upon prm for which the
 * Kaszhdan-Lutszig polynom P_{prm}(p) is different from 0. In vc_kl, there
 * are the P_{prm}(p).
 */

INT
upper_kl_ls(prm, vc_prm, vc_kl)
OP              prm, vc_prm, vc_kl;
{
   OP              li_prm = callocobject(), li_kl = callocobject();
   if (not EMPTYP(vc_prm))
      freeself(vc_prm);
   if (not EMPTYP(vc_kl))
      freeself(vc_kl);
   ordre=S_P_LI(prm);
   init(SYMLIST, li_prm);
   init(SYMLIST, li_kl);
   cell(prm, li_prm, li_kl, 1);
   if (S_L_S(li_prm) == NULL)
   {
      init(VECTOR, vc_prm);
      init(VECTOR, vc_kl);
   } else
   {
      t_LIST_VECTOR(li_prm, vc_prm);
      t_LIST_VECTOR(li_kl, vc_kl);
   }
   SYMfreeall(li_prm);
   SYMfreeall(li_kl);
   return OK;
}

/*
 * Returns in vc_prm the normalized permutations p below prm for which the
 * Kaszhdan-Lutszig polynom P_{p}(prm) is different from 0. In vc_kl, there
 * are the P_{p}(prm).
 */

INT  lower_kl(OP prm, OP vc_prm, OP vc_kl)
{
	OP prm1=callocobject(), vc_prm1=callocobject();
	if (!EMPTYP(vc_prm)) freeself(vc_prm);
	if (!EMPTYP(vc_kl)) freeself(vc_kl);
	reverse_prm(prm, prm1);
	upper_kl_ls(prm1, vc_prm1, vc_kl);
	reverse_prm_vc(vc_prm1, vc_prm);
	SYMfreeall(vc_prm1); SYMfreeall(prm1);
	return OK;
}

/*
vc_prm is a  vector
vc_kl is s  vector
The output vc_prm_mp is the vector of pairs (prm_elt, kl_elt)
where prm_elt, kl_elt are elements of vc_prm  and vc_kl
kl_elt is of type monopoly
*/

INT m_prm_kl2vc(vc_prm, vc_kl, vc_prm_mp)
OP vc_prm, vc_kl, vc_prm_mp;
{
        int i;
        m_il_v(S_V_LI(vc_prm), vc_prm_mp);
        for(i=0; i<S_V_LI(vc_prm); i++){
                OP obj=callocobject();
                m_il_v(2L, S_V_I(vc_prm_mp,i));
                copy(S_V_I(S_V_I(vc_prm,i), 0L),S_V_I(S_V_I(vc_prm_mp,i),0L));
                m_v_mp( S_V_I(vc_kl,i), obj);
                c_v_i(S_V_I(vc_prm_mp,i),1L,obj);
        }
}

/*
 * Returns in vc the pair (p, P_{prm}(p)), where
 * p are normalized permutations upon prm for which the
 * Kaszhdan-Lutszig polynom P_{prm}(p) is different from 0.
 * Convention of LS 
*/

INT upper_kl2_ls(OP prm, OP  vc){
	OP vc_prm=callocobject();
	OP vc_kl=callocobject();

	if (!EMPTYP(vc)) freeself(vc);
	ordre=(unsigned char) S_P_LI(prm);
	upper_kl_ls(prm, vc_prm, vc_kl);
	m_prm_kl2vc(vc_prm, vc_kl, vc);
	SYMfreeall(vc_prm); SYMfreeall(vc_kl);
	return OK;
}
/*
 * Returns in vc the pair (p, P_{p}(prm)), where
 * p are normalized permutations below prm for which the
 * Kaszhdan-Lutszig polynom P_{p}(prm) is different from 0.
 * Convention of KL
 */

INT lower_kl2(prm, vc)
OP              prm, vc;
{
	OP prm_ret, vc_prm, vc_kl, vc_prm_ret, vc_kl_ret;

	if (!EMPTYP(vc)) freeself(vc);
	ordre=(unsigned char) S_P_LI(prm);
	prm_ret=callocobject();
	vc_prm=callocobject();
	vc_kl=callocobject();
	vc_prm_ret=callocobject();
	reverse_prm(prm, prm_ret);
	upper_kl_ls(prm_ret, vc_prm_ret, vc_kl);
	reverse_prm_vc(vc_prm_ret, vc_prm);
	m_prm_kl2vc(vc_prm, vc_kl, vc);
	SYMfreeall( vc_kl);
	SYMfreeall(vc_prm); SYMfreeall(vc_prm_ret);
	SYMfreeall(prm_ret);
	return OK;
}

/*
Transforms a vector of integers vc into a monopoly object  mp
*/

INT m_v_mp(vc, mp) OP vc,mp;
{
	int i; OP obj, tp;

	init(MONOPOLY, mp);
	obj=callocobject();
	tp=callocobject();
	for(i=0;i<S_V_LI(vc); i++){
		M_I_I(i,obj);
		m_skn_mp(obj, S_V_I(vc, i), NULL, tp);
		add(mp, tp, mp);
	}
	SYMfreeall(obj); SYMfreeall(tp);
}

/*
 * Returns in vc_prm the normalized permutations p upon prm for which the
 * Kaszhdan-Lutszig polynom P_{prm}(p) is different from 0 and from 1. In
 * vc_kl, there are the P_{prm}(p).
 */

INT
upper_kl_notone_ls(prm, vc_prm, vc_kl)
OP              prm, vc_prm, vc_kl;
{
   OP              li_prm = callocobject(), li_kl = callocobject();
   if (not EMPTYP(vc_prm))
      freeself(vc_prm);
   if (not EMPTYP(vc_kl))
      freeself(vc_kl);
   ordre=S_P_LI(prm);
   init(SYMLIST, li_prm);
   init(SYMLIST, li_kl);
   cell(prm, li_prm, li_kl, 2);
   if (S_L_S(li_prm) == NULL)
   {
      init(VECTOR, vc_prm);
      init(VECTOR, vc_kl);
   } else
   {
      t_LIST_VECTOR(li_prm, vc_prm);
      t_LIST_VECTOR(li_kl, vc_kl);
   }
   SYMfreeall(li_prm);
   SYMfreeall(li_kl);
   return OK;
}

/*
 * Returns in vc_prm the normalized permutations p below prm for which the
 * Kaszhdan-Lutszig polynom P_{p}(prm) is different from 0 and 1. In vc_kl, there
 * are the P_{p}(prm).
 */

INT  lower_kl_notone(OP prm, OP vc_prm, OP vc_kl)
{
	OP prm1=callocobject(), vc_prm1=callocobject();
	if (!EMPTYP(vc_prm)) freeself(vc_prm);
	if (!EMPTYP(vc_kl)) freeself(vc_kl);
	reverse_prm(prm, prm1);
	upper_kl_notone_ls(prm1, vc_prm1, vc_kl);
	reverse_prm_vc(vc_prm1, vc_prm);
	SYMfreeall(vc_prm1); SYMfreeall(prm1);
	return OK;
}

/*
 * Returns in vc_prm the normalized permutations p upon prm for which the
 * Kazhdan-Lutszig polynoms P_{prm}(p) are different from 0 and from 1 and
 * are minimal in the Bruhat order. In vc_kl, there are the P_{prm}(p).
 */

INT
upper_kl_minimal_ls(prm, vc_prm, vc_kl)
OP              prm, vc_prm, vc_kl;
{
   OP              li_prm = callocobject(), li_kl = callocobject();
   if (not EMPTYP(vc_prm))
      freeself(vc_prm);
   if (not EMPTYP(vc_kl))
      freeself(vc_kl);
   init(SYMLIST, li_prm);
   init(SYMLIST, li_kl);
   ordre=S_P_LI(prm);
   cell(prm, li_prm, li_kl, 3);
   if (S_L_S(li_prm) == NULL)
   {
      init(VECTOR, vc_prm);
      init(VECTOR, vc_kl);
   } else
   {
      t_LIST_VECTOR(li_prm, vc_prm);
      t_LIST_VECTOR(li_kl, vc_kl);
   }
   SYMfreeall(li_prm);
   SYMfreeall(li_kl);
   return OK;
}

/*
 * Returns in vc_prm the normalized permutations p below prm for which the
 * Kazhdan-Lutszig polynoms P_{p}(prm) are different from 0 and from 1 and
 * are minimal in the Bruhat order. In vc_kl, there are the P_{p}(prm).
 */

INT  lower_kl_maximal(OP prm, OP vc_prm, OP vc_kl)
{
	OP prm1=callocobject(), vc_prm1=callocobject();
	if (!EMPTYP(vc_prm)) freeself(vc_prm);
	if (!EMPTYP(vc_kl)) freeself(vc_kl);
	reverse_prm(prm, prm1);
	upper_kl_minimal_ls(prm1, vc_prm1, vc_kl);
	reverse_prm_vc(vc_prm1, vc_prm);
	SYMfreeall(vc_prm1); SYMfreeall(prm1);
	return OK;
}

/*
Views the rectrices and the corectrices of a permutation a
*/

INT view_rctr(OP a){
  OP rv=callocobject(), rct=callocobject();
  fastrectr(a,rct);
  printf("Rectr de "); print(a); printf(":  "); println(rct);
  reverse_prm(a, rv); fastrectr(rv,rct);
  printf("Corectr de "); print(a); printf(":  "); println(rct);
  SYMfreeall(rv); SYMfreeall(rct);
  return OK;
}

/*
Views the KL polynomial c of P(a,b)
The  rectrices and the corectrices b are viewed
The symbol * means that KL polynomial is of maximal degree
*/

INT ss_view(OP a, OP b, OP c, int boo){
  view_rctr(b);
  if(boo==0){
  	printf("KL("); print(b); printf(", "); print(a); printf(")=");
	if(kl_max(b, a, c)==1L){ printf("* ");}
  }
  else{
	printf("KL("); print(a); printf(", "); print(b); printf(")=");
	if(kl_max(a, b, c)==1L){ printf("* ");}
  }
  println(c); 
  return OK;
}

/*
Views the KL polynomial c of P(a,b)
The  rectrices and the corectrices b are viewed
The symbol * means that KL polynomial is of maximal degree
*/

INT view(OP a, OP b, OP c){
  view_rctr(a);
  ss_view(a, b, c, 1);
  return OK;
}


INT ssview_vc(OP oprm, OP vc_prm, OP vc_kl , int boo)
{
	INT i;
	view_rctr(oprm);
	for(i=0;i<S_V_LI(vc_prm); i++){
		ss_view(oprm, S_V_I(vc_prm, i), S_V_I(vc_kl,i), boo);
		putchar('\n');
	}
	return OK;
}

/*
vc_prm is a vector of permutations p
vc_kl is a vector of KL polynoms P_{oprm,p}
imprime rectrices, corectrices 
*/

INT view_vc(OP a, OP b, OP c){
	return(ssview_vc(a,b,c,0));
}
/*
vc_prm is a vector of permutations p
vc_kl is a vector of KL polynoms P_{oprm,p}
imprime rectrices, corectrices 
*/

INT view_vc_ls(OP a, OP b, OP c){
	return(ssview_vc(a,b,c,1));
}

/*
 * views all the normalized permutations upon the permutation prm new
 * algorithm
 */

INT
view_upper(oprm, fl)
OP              oprm;
INT             fl;
{

   unsigned char   nb_lgn, *lgn, **tb, nb_col, *col, **tb_cumul;
   unsigned char  *tb_lgn_cumul, *tb_lgn_cumul2, *bcumul, *bcumul_av;
   unsigned char  *tb_lgn, tmp, tmp_pal, *blgn, *zero;
   unsigned char   recul, *bcol, nb, **bb, **bh;
   unsigned char   av2, *baf, *bs, *tb_lgn_bh;
   signed char     ind_col, ind_col_pal, ind_lgn;
   unsigned char  *prm_gen, *prm_gen_ret, *col_cum;
   unsigned char  *bas, y, *bbh;
   int             i, j;
   unsigned char  *prm, nb_coins;
   OP              oprm_gen, res, vc;
   struct lst_rct *lst, *blst, *lst_gen, *lst_gen_ret;
   unsigned char  *mes1, *bmes1, *mes2, *bmes2, *mes3, *bmes3, place;

   for (i = 0; i < ordre; i++)
      if (S_P_II(oprm, i) != i + 1)
	 break;
   if (i == ordre)
      return OK;

   for (i = 0; i < ordre; i++)
      if (S_P_II(oprm, i) != ordre - i)
	 break;
   if (i == ordre)
      return OK;

   if (fl == 1 || fl == 2)
   {
      res = callocobject();
      vc = callocobject();
      oprm_gen = callocobject();
      m_il_p(ordre, oprm_gen);
      prm_gen_ret = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));
   }
   prm = t_p_uchar(oprm);

   nb_coins = rct(prm, &lst);

   bmes1 = mes1 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes2 = mes2 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));
   bmes3 = mes3 = (unsigned char *) SYM_malloc(nb_coins * sizeof(unsigned char));

   blst = lst;
   while (blst != NULL)
   {
      *bmes1++ = blst->rct[0] + blst->rct[1];
      *bmes2++ = blst->rct[0] + blst->rct[2];
      *bmes3++ = blst->rct[1];
      blst = blst->nxt;
   }

   build_01_el(prm, &nb_lgn, &lgn, &tb, &nb_col, &col, &tb_cumul);
   ind_lgn = nb_lgn - 2;
   place = ordre - lgn[ind_lgn + 1];
   zero = (unsigned char *) SYM_calloc(nb_col, sizeof(unsigned char));
   col_cum = (unsigned char *) SYM_malloc((nb_col + 1) * sizeof(unsigned char));
   prm_gen = (unsigned char *) SYM_malloc(ordre * sizeof(unsigned char));

   baf = col_cum;
   *baf++ = 0;
   *baf++ = av2 = *col;
   bcol = col + 1;
   for (i = 1; i < nb_col; i++, baf++, bcol++)
   {
      *baf = *bcol + av2;
      av2 = *baf;
   }

   recul = 1;

   while (ind_lgn >= 0)
   {
      if (ind_lgn != nb_lgn - 1)
      {
	 tb_lgn = *(tb + ind_lgn);
	 tb_lgn_cumul = *(tb_cumul + ind_lgn);
	 if (recul == 1)
	 {
	    ind_col = nb_col - 2;
	    tmp = *(tb_lgn + ind_col + 1);
	    place -= tmp;
	 } else
	 {
	    bcol = col;
	    tmp = lgn[ind_lgn];
	    ind_col = 0;
	    bcumul_av = *(tb_cumul + ind_lgn - 1);
	    bcumul = tb_lgn_cumul;
	    blgn = tb_lgn;
	 }

	 while (ind_col >= 0)
	 {
	    if (recul == 1)
	    {
	       blgn = tb_lgn + ind_col;
	       while (ind_col >= 0 && *blgn == 0)
	       {
		  blgn--;
		  ind_col--;
	       }
	       if (ind_col == nb_col - 1)
	       {
		  ind_col = nb_col - 2;
		  tmp += *blgn;
		  place -= *blgn;
		  continue;
	       }
	       if (ind_col < 0)
		  break;
	       place--;
	       tmp++;
	       bcumul = tb_lgn_cumul + ind_col;
	       (*bcumul)--;
	       (*blgn)--;
	       ind_col++;
	       blgn++;
	       bcumul++;
	       bcol = col + ind_col;
	       if (ind_lgn == 0)
	       {
		  bcumul_av = zero;
	       } else
	       {
		  bcumul_av = *(tb_cumul + ind_lgn - 1) + ind_col;
	       }
	       recul = 0;
	    }
	    /* End of if(recul==1) */
	    else
	    {
	       nb = *bcol - *bcumul_av;
	       if (nb == 0)
	       {
		  *bcumul = *bcumul_av;
		  *blgn = 0;
	       }
	       /* End of if (nb==0) */
	       else
	       {
		  y = (tmp < nb) ? tmp : nb;
		  y = tst_rct(mes1, mes2, mes3, nb_coins, place, y, bcumul - 1,
			  col_cum + nb_col - 1, bcumul_av, ind_col, nb_col);
		  if (y == 0)
		  {
		     *bcumul = *bcumul_av;
		     *blgn = 0;
		  }
		  /* End of if (y==0) */
		  else
		  {
		     if (tmp <= y)
		     {
			*blgn = tmp;
			place += tmp;
			*bcumul = *bcumul_av + tmp;
			tmp = 0;
			bcumul_av++;
			ind_col++;
			blgn++;
			bcumul++;
			for (; ind_col < nb_col; ind_col++, blgn++, bcumul++, bcumul_av++)
			{
			   *bcumul = *bcumul_av;
			   *blgn = 0;
			}
			break;
		     }
		     /* End of if(tmp<=nb) */
		     else
		     {
			*blgn = y;
			place += y;
			*bcumul = *bcumul_av + y;
			tmp -= y;
		     }		/* End of else of if(tmp<=y) */
		  }		/* End of else of if(y==0) */
	       }		/* End of else of if(nb==0) */

	       bcumul++;
	       blgn++;
	       ind_col++;
	       bcol++;
	       bcumul_av++;

	       if (ind_col == nb_col)
	       {
		  recul = 1;
		  ind_col--;
	       }
	    }			/* End of else of if(recul==1) */

	 }			/* End of while(ind_col>=0) */

	 if (ind_col == -1)
	    ind_lgn--;
	 else
	    ind_lgn++;

      }
      /* End of if (ind_lgn!= nb_lgn-1) */
      else
      {

	 bcumul_av = *(tb_cumul + nb_lgn - 2);
	 blgn = *(tb + nb_lgn - 1);
	 bcol = col;
	 for (i = 0; i < nb_col; i++, bcol++, bcumul_av++, blgn++)
	 {
	    y = *bcol - *bcumul_av;
	    if (y != 0)
	    {
	       if (tst_rct_bis(mes1, mes2, mes3, nb_coins, place, y, bcol - 1, col_cum + nb_col - 1, bcumul_av, i, nb_col) == 0)
		  break;
	    }
	    *blgn = y;
	    place += y;
	 }
	 place = ordre - lgn[ind_lgn];
	 recul = 1;
	 ind_lgn--;
	 if (i != nb_col)
	    continue;

	 /*
	  * view_01(tb, nb_lgn, nb_col);
	  */
	 t_01_prm(tb, tb_cumul, col_cum + 1, nb_col, nb_lgn, &prm_gen);


	 if (fl == 0)
	 {
	    cte++;
	    voirbf(prm_gen);
	 } else
	 {
	    t_uchar_p(prm_gen, oprm_gen);
	    calculm(oprm, oprm_gen, res);
	    if (fl == 1 || (fl == 2 && not einsp(res)))
	    {
	       print(oprm_gen);
	       putchar('\t');
	       rct(prm_gen, &lst_gen);
	       view_rct(lst_gen);
	       free_lst_rct(lst_gen);
	       m_mp_v(res, vc);
	       print(vc);
	       putchar('\t');
	       freeself(vc);
	       prm_ret(prm_gen, prm_gen_ret + ordre - 1);
	       rct(prm_gen_ret, &lst_gen_ret);
	       view_rct(lst_gen_ret);
	       putchar('\n');
	       free_lst_rct(lst_gen_ret);
	    }
	    freeself(res);
	    freeself(oprm_gen);
	    m_il_p(ordre, oprm_gen);
	 }
      }				/* End of else of if (ind_lgn!= nb_lgn-1) */

   }				/* End of while(ind_lgn>=0 && ind_lgn <
				 * nb_lgn) */

   SYM_free(lgn);
   SYM_free(zero);
   SYM_free(prm_gen);
   SYM_free(col_cum);

   SYM_free(col);
   free2(tb, nb_lgn);
   free2(tb_cumul, nb_lgn);
   SYM_free(mes1);
   SYM_free(mes2);
   SYM_free(mes3);
   SYM_free(prm);
   free_lst_rct(lst);
   if (fl == 1 || fl == 2)
   {
      SYMfreeall(res);
      SYMfreeall(vc);
      SYMfreeall(oprm_gen);
      SYM_free(prm_gen_ret);
   }
   return OK;
}

/*
 * views all normalized permutations upon prm
   */
  
  INT
  view_upper_prm_ls(prm)
  OP              prm;
  {
     OP              opds = callocobject();
     M_I_I(100L, opds);
     ordre=S_P_LI(prm);
     view_upper(prm, 0);
     SYMfreeall(opds);
     return OK;
  }
  
  /*
   * views KL polnynoms P_{u,v} for all normalized permutations v upon u.
   */
  
  INT
  view_upper_kl_ls(u)
  OP              u;
  {
     OP              opds = callocobject();
     M_I_I(100L, opds);
     ordre=S_P_LI(u);
     view_upper(u, 1);
     SYMfreeall(opds);
     return OK;
  }
  
  /*
   * views KL polnynoms P_{u,v} different than one for all normalized
   * permutations v upon u.
   */
  
  INT
  view_upper_kl_notone_ls(u)
  OP              u;
  {
     OP              opds = callocobject();
     M_I_I(100L, opds);
     ordre=S_P_LI(u);
     view_upper(u, 2);
     SYMfreeall(opds);
     return OK;
  }
  
  swap_prm(a, ind)
  OP              a;
  INT             ind;
  {
     INT             tp = S_P_II(a, ind - 1);
     M_I_I(S_P_II(a, ind), S_P_I(a, ind - 1));
     M_I_I(tp, S_P_I(a, ind));
     return OK;
  }
  
  /*
  With LS formalism,
  w must be normalized according to v
  return 1, if w is  for v a maximal singular point of type I(n)
  return 0 and puts in res 1+q^n if  w is not for v a singular point of type I(n) 
  */
  
  INT rec_sing1_ls(OP v, OP w, OP res){
    static unsigned char av0, av1, av2, av3, stk[4];
    static unsigned char av, cr;
    int boo, i, h;
  
    boo=0;
    ordre=S_P_LI(v);
    for(i=0; i< ordre; i++){
      if(S_P_II(v, i) != S_P_II(w, i)){
        switch(boo){
          case 0:
            av0=S_P_II(v, i);
            if(S_P_II(w, i) <4  || av0 > ordre-2) return 0;
            stk[0]=i;
            boo++; break;
          case 1:
            av1=S_P_II(v, i);
            if(av1>av0) return 0;
            if(S_P_II(w, i) !=av0) return 0;
            stk[1]=i;
            boo++; break;
          case 2:
            av2=S_P_II(v, i);
            if(av2<av0+2) return 0;
  	  if(S_P_II(w, stk[0])!= av2) return 0;
            stk[2]=i;
            boo++; break;
          case 3:
            av3=S_P_II(v, i);
  	  if(av3> av2 || av3<av0) return 0;
  	  if(av3!=S_P_II(w, stk[2]) || S_P_II(w, i)!=av1) return 0;
            boo++; break;
          case 4: return 0;
        }/* End of switch */
      }/*End of if(S_P_II(v, i) != S_P_II(w, i))*/
    }/* End of for(i=0; i< ordre; i++)*/
  if(boo!=4){
    h=1; av=av0;
    for(i=stk[1]+1; i<stk[2]; i++){
      cr=S_P_II(v, i);
      if(cr>av1 && cr<av2){
        if(cr<av || cr>av3) return 0;
        else{ av=cr; h++; }
      }
    }/* End of for(i=stk[1]+1; i<stk[2]; i++)*/
    b_skn_mp(callocobject(), callocobject(), NULL, res);
    M_I_I(h, S_PO_S(res));
    M_I_I(1L, S_PO_K(res));
    add_apply(cons_eins, res);
    return 1L;
  }  
  return 0;
}


/*
v and w are 2 permutations.
w must be normalized according to v.
return 1 and puts in res 1+q, if w is a maximal singular point of type I(a,b) for v.
if not, return 0
*/

INT rec_sing2_ls(OP v, OP w, OP res){
	unsigned char boo, a, b, av0, aw1, aw, av;
	int i;

	ordre=S_P_LI(v);
	boo=0; a=1; b=1;
	for(i=0; i<ordre; i++){
		if(S_P_II(v, i)!= S_P_II(w,i)){
			switch(boo){
				case 0:
					if(S_P_II(v, i)> S_P_II(w, i)) return 0;
					av0=S_P_II(v, i);
					aw=S_P_II(w, i);
					boo++; break;
				case 1:
					if(S_P_II(v, i)>S_P_II(w, i)) return 0;
					if(S_P_II(v, i)==aw){
						b++;
						aw=S_P_II(w, i);
					}
					else{
						if(S_P_II(w, i)!=av0) return 0;
						av=S_P_II(v,i);
						boo++;
					}
					break;
				case 2:
					if(S_P_II(v,i)!=aw)  return 0;
		if(S_P_II(w, i)<av0 || S_P_II(w, i)>S_P_II(v,i)) return 0;
					aw1=S_P_II(w, i);
					boo++;
					break;
				case 3:
					if(S_P_II(w, i)!=av) return 0;
					if(S_P_II(w, i) > S_P_II(v,i)) return 0;
					if(S_P_II(v,i)>av0){
						if(S_P_II(v,i)!=aw1) return 0;
						boo++;
					}
					else{
						av=S_P_II(v,i); a++;
					}
					break;
				case 4: return 0;
			}
		}
		else{
			switch(boo){
				case 1:
					if(S_P_II(v,i)>av0 && S_P_II(v,i)< aw)
						return 0;
					break;
				case 2:
					if(S_P_II(v,i)>av && S_P_II(v,i)<aw)
						return 0;
					break;
				case 3:
					if(S_P_II(v,i)>av && S_P_II(v,i)<aw1)
						return 0;
					break;
				default: break;
			}
		}
	}
	if(boo==4){
		b_skn_mp(callocobject(), callocobject(), NULL, res);
		M_I_I(1L, S_PO_K(res));
		M_I_I(1L, S_PO_S(res));
		add_apply(cons_eins, res);
		return 1;
	}
	else return 0;
}

/*
v and w are 2 permutations.
w must be normalized according to v.
return 1 and puts in res 1+q^n, if w is a maximal singular point of type II(a,b) for v.
if not, return 0
*/

INT rec_sing3_ls(OP v, OP w, OP res){
	unsigned char boo, a, b, av0, aw0, aw, av, aw1, min;
	int i;
	OP tmp, tp;

	ordre=S_P_LI(v);
	boo=0; a=1; b=1;
	for(i=0; i<ordre; i++){
		if(S_P_II(v, i)!= S_P_II(w,i)){
			switch(boo){
				case 0:
			  		if(S_P_II(w,i)< S_P_II(v,i)) return 0;
					if(S_P_II(v,i)+3> ordre) return 0;
					av0=S_P_II(v, i);
					aw0=aw=S_P_II(w, i);
					boo++; break;
				case 1:
					if(S_P_II(v, i)==aw){
						if(S_P_II(w, i)<aw) return 0;
						aw=S_P_II(w, i); b++;
					}
					else{
						if(S_P_II(w, i)!=av0) return 0;
						if(S_P_II(v,i)<av0 || S_P_II(v, i)> aw0) return 0;
						if(b==1) return 0;
						av=S_P_II(v, i);
						aw1=aw; boo++;
					}
					break;
				case 2:
					a++;
					if(S_P_II(w, i)!=av) return 0;
					if(S_P_II(v, i)> S_P_II(w, i)){
						if(S_P_II(v, i)< aw0) av=S_P_II(v, i);
						else{
							if(S_P_II(v,i)!=aw1) return 0;
							boo++;
						}
					}
					else return 0;
					break;
				case 3: return 0;
			}
		}
		else{
			switch(boo){
				case 1:
			if(S_P_II(v,i)<aw && S_P_II(v, i)>av0) return 0;
					break;
				case 2:
			if(S_P_II(v,i)>av && S_P_II(v, i)<aw1) return 0;
					break;
				default: break;
			}
		}
	}
	if(boo==3){
		min=a<b?a:b;
		tmp=NULL;
		for(i=min-1; i>=0; i--){
			if(i!=0) tp=callocobject();
			else tp=res;
			b_skn_mp(callocobject(), callocobject(), tmp, tp);
			M_I_I(1L, S_PO_K(tp));
			M_I_I(i, S_PO_S(tp));
			tmp=tp;
		}
	/*
	printf("%d ",ordre);
	for(i=0;i<ordre; i++) printf("%d ", S_P_II(v,i)); printf("\n");
	printf("%d ",ordre);
	for(i=0;i<ordre; i++) printf("%d ", S_P_II(w,i)); printf("\n");
	  println(res);
	*/
		return 1;
	}
	return 0;
}

/*
v and w are 2 permutations.
w must be normalized according to v.
return 1 and puts in res 1+q^n, if w is a maximal singular point
of type II(a,b) or I(n) for v.
if not, return 0
*/

INT rec_sing_ls(OP v, OP w, OP res){
	INT ret;
	nb1++;
	if((ret=rec_sing3_ls( v,  w,  res))==0L){
		if((ret=rec_sing1_ls( v,  w,  res))==0L)
			ret=rec_sing2_ls( v,  w,  res);
	}
	if(ret==1) nb2++;
	return ret;
}

/*
 * Puts res, the result of P_{u,w}, in the hash table
 */

INT
hash_put(u, w, res)
OP              u, w, res;
{
   INT             i, pas;
   UINT nb=0;

   pas = HASH_MAX / ordre;
   for (i = 0; i < S_P_LI(w); i++)
   {
      /* Modification of the Hashing function: in hash_search,  too */
      /*
       * nb += (((S_P_II(u, i)>>1 ) ^ (S_P_II(w, i))+47*(i+1)) * (i+1) *
       * pas)+pas*(i+1);
       */
/*
      nb += (((S_P_II(u, i) + 23 *pas* (i + 1)) *pas* (S_P_II(w, i)) + 47 * (i + 1)) * (i + 1) ) ;
      nb += (((S_P_II(u, i)*(pas+1) + 23 * (i + 1)) *(pas+1)* (S_P_II(w, i)))) ;
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(w, i)) *(pas+ordre*i)* S_P_II(w, i) ;
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(w, i)) *(pas*S_P_II(u, i)+ordre*(i+1))* S_P_II(w, i) ;
*/
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(w, i)) *(pas*S_P_II(u, i)+ordre*(i+1))* S_P_II(w, i) ;
 nb %= HASH_MAX;
   }
   cbang++;
   if (hash_table[nb] == NULL)
   {
      hash_table[nb] = callocobject();
      m_il_v(3L, hash_table[nb]);
      copy(u, S_V_I(hash_table[nb], 0L));
      copy(w, S_V_I(hash_table[nb], 1L));
      copy(res, S_V_I(hash_table[nb], 2L));
   } else
   {
      cbing++;
      /*
       * printf("nb %d\n",nb); println(S_V_I(hash_table[nb],0L));
       * println(S_V_I(hash_table[nb],1L)); println(u); println(w);
       * printf("_____________________________________\n");
       */

      /*
       * if (comp(S_V_I(hash_table[nb], 0L), u) != 0L ||
       * comp(S_V_I(hash_table[nb], 1L), w) != 0L)
       */
      {
	 OP              invw = callocobject(), invu = callocobject();
	 numberof_inversionen(u, invu);
	 numberof_inversionen(w, invw);
	 if (S_I_I(invw) - S_I_I(invu) > ordre)
	 {
	    brrr++;

	    /*
	     * print(u); print(w); printf(" %ld\n",S_I_I(invw)-S_I_I(invu));
	     * numberof_inversionen(S_V_I(hash_table[nb], 0L), invu);
	     * numberof_inversionen(S_V_I(hash_table[nb], 1L), invw); print(
	     * S_V_I(hash_table[nb], 0L)); print( S_V_I(hash_table[nb], 1L));
	     * printf(" %ld\n",S_I_I(invw)-S_I_I(invu));
	     * printf("______________________\n");
	     */
	    copy(u, S_V_I(hash_table[nb], 0L));
	    copy(w, S_V_I(hash_table[nb], 1L));
	    copy(res, S_V_I(hash_table[nb], 2L));
	 }
	 cbong++;
	 SYMfreeall(invu);
	 SYMfreeall(invw);
      }
   }
   return OK;
}

/*
 * returns 1, if the polynom is in the table 0, if not.
 */

INT
hash_search(u, v, res)
OP              u, v, res;
{
   INT             i,  pas;
   UINT		nb=0;

   pas = HASH_MAX / ordre;
   for (i = 0; i < S_P_LI(v); i++)
   {
      /* Modification of the Hashing function: in hash_put,  too */
/*
      nb += (((S_P_II(u, i) + 23 *pas* (i + 1)) *pas* (S_P_II(v, i)) + 47 * (i + 1)) * (i + 1) ) ;
      nb += (((S_P_II(u, i)*(pas+1) + 23 * (i + 1)) *(pas+1)* (S_P_II(v, i)))) ;
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(w, i)) *(pas+ordre*i)* S_P_II(w, i) ;
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(v, i)) *(pas*S_P_II(u, i)+ordre*(i+1))* S_P_II(v, i) ;
*/
      nb += (S_P_II(u, i)*(pas+1) + 23 * (i + 1) * S_P_II(v, i)) *(pas*S_P_II(u, i)+ordre*(i+1))* S_P_II(v, i) ;
      nb %= HASH_MAX;
   }
   if (hash_table[nb] != NULL)
   {
      if (EQ(S_V_I(hash_table[nb], 0L), u)
	  && EQ(S_V_I(hash_table[nb], 1L), v))
      {
	 copy(S_V_I(hash_table[nb], 2L), res);
	 return 1L;
      }
   }
   return 0L;
}

/*
 * Returns 2 when u is not lower or equal to w. Returns 1 when
 * lg(w)-lg(u)<=2, or if P_{u,w} is already in the Hash table. Returns 0 if
 * not. The Kashdan Lutzig polynom is in res. Makes the Bruhat test
 */

INT
debut(u, w, res)
OP              u, w, res;
{
   OP              nb1, nb2;
   INT             ret;

   if (not EMPTYP(res))
      freeself(res);
   min_rep(u, w);
   ret = bruhat_comp_perm(u, w);
   if (ret != -1)
   {				/* i.e. not u<w */
      if (ret == 0L)
      {
	 M_I_I(1L, res);
	 return 1L;
      } else
      {
	 M_I_I(0L, res);
	 return 2L;
      }
   } else
   {
      nb1 = callocobject();
      nb2 = callocobject();
      numberof_inversionen(u, nb1);
      numberof_inversionen(w, nb2);
      if (S_I_I(nb1) + 2L >= S_I_I(nb2))
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 M_I_I(1L, res);
	 return 1L;
      }
      ret = hash_search(u, w, res);
      if (ret == 1L)
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 return 1L;
      }
      if (S_I_I(nb1) + 3L <= S_I_I(nb2)){
        ret=rec_sing_ls(u, w, res);
        if(ret==1){
          hash_put(u, w, res);
          SYMfreeall(nb1);
          SYMfreeall(nb2);
          return 1;
        }
      }
      SYMfreeall(nb1);
      SYMfreeall(nb2);
      return 0L;
   }
}

/*
 * Returns 1 when lg(w)-lg(u)<=2, or if P_{u,w} is already in the Hash table.
 * Returns 0 if not. The Kashdan Lutzig polynom is in res. Don't make the
 * Bruhat test
 */

INT
deb_tr(u, w, res)
OP              u, w, res;
{
   OP              nb1, nb2;
   INT             i;

   if (not EMPTYP(res))
      freeself(res);
   min_rep(u, w);
   for (i = 0L; i < ordre; i++)
      if (S_P_II(u, i) != S_P_II(w, i))
	 break;
   if (i == ordre)
   {
      M_I_I(1L, res);
      return 1L;
   } else
   {
      nb1 = callocobject();
      nb2 = callocobject();
      numberof_inversionen(u, nb1);
      numberof_inversionen(w, nb2);
      if (S_I_I(nb1) + 2L >= S_I_I(nb2))
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 M_I_I(1L, res);
	 return 1L;
      }
      i = hash_search(u, w, res);
      if (i == 1L)
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 return 1L;
      }
      if (S_I_I(nb1) + 3L <= S_I_I(nb2)){
        i=rec_sing_ls(u, w, res);
        if(i==1){
          hash_put(u, w, res);
          SYMfreeall(nb1);
          SYMfreeall(nb2);
          return 1;
        }
      }
      SYMfreeall(nb1);
      SYMfreeall(nb2);
      return 0L;
   }
}

/*
 * same as debut but is specific for the computation of the second term of the
 * KL recurrence.
 */

INT 
deb2(u, w, ind, res)
OP              u, w, res;
INT             ind;
{
   OP              uu = callocobject(), ww = callocobject();
   INT             i, ret;
   OP              nb1, nb2;

   if (not EMPTYP(res))
      freeself(res);
   m_il_p(S_P_LI(u), uu);
   m_il_p(S_P_LI(w), ww);
   for (i = 0L; i < S_P_LI(u); i++)
   {
      M_I_I(S_P_II(u, i), S_P_I(uu, i));
      M_I_I(S_P_II(w, i), S_P_I(ww, i));
   }
   tri(uu, 0L, ind - 1L);
   tri(ww, 0L, ind - 1L);
   for (i = 0; i < ind; i++)
   {
      if (S_P_II(uu, i) > S_P_II(ww, i))
      {
	 M_I_I(0L, res);
	 SYMfreeall(uu);
	 SYMfreeall(ww);
	 return 2L;
      }
   }
   SYMfreeall(uu);
   SYMfreeall(ww);

   if ((ind - 2 >= 0L && S_P_II(u, ind - 2) < S_P_II(u, ind - 1) && S_P_II(u, ind - 2) > S_P_II(u, ind))
       || (ind + 1 <= S_P_LI(u) && S_P_II(u, ind + 1) > S_P_II(u, ind) && S_P_II(u, ind + 1) < S_P_II(u, ind - 1)))

      min_rep_L(u, w);
   for (i = 0L; i < S_P_LI(w); i++)
   {
      if (S_P_II(u, i) != S_P_II(w, i))
	 break;
   }
   if (i == S_P_LI(w))
   {
      M_I_I(1L, res);
      return 1L;
   } else
   {
      nb1 = callocobject();
      nb2 = callocobject();
      numberof_inversionen(u, nb1);
      numberof_inversionen(w, nb2);
      if (S_I_I(nb1) + 2L >= S_I_I(nb2))
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 M_I_I(1L, res);
	 return 1L;
      }
      ret = hash_search(u, w, res);
      if (ret == 1L)
      {
	 SYMfreeall(nb1);
	 SYMfreeall(nb2);
	 return 1L;
      }
      if (S_I_I(nb1) + 3L <= S_I_I(nb2)){
        ret=rec_sing_ls(u, w, res);
        if(ret==1){
          hash_put(u, w, res);
          SYMfreeall(nb1);
          SYMfreeall(nb2);
          return 1;
        }
      }
      SYMfreeall(nb1);
      SYMfreeall(nb2);
      return 0L;
   }
}

/*
 * Puts in ld the leading coefficient of the monopoly and in po the leading
 * power.
 */

INT
ld_coef(z, ld, po)
OP              z, ld, po;
{
   INT             maxs = -1L;
   INT             maxc = 0;

   while (z != NULL)
   {
      if (S_I_I(S_PO_S(z)) > maxs)
      {
	 maxs = S_I_I(S_PO_S(z));
	 maxc = S_PO_KI(z);
      }
      z = S_L_N(z);
   }
   M_I_I(maxc, ld);
   M_I_I(maxs, po);
   return OK;
}


/*
 * u is a vexillary permutation, w is a permutation res is the KL polynom
 * P_{u,w}. This function is better than kl_vex be cause it integers
 * normalisation of w according with u.
 */

INT
calculv(u, w, res)
OP              u, w, res;
{
   OP              w1;
   INT             nb, ret;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   w1 = callocobject();
   copy(w, w1);
   ret = deb_tr(u, w, res);

   if (ret == 0)
      kl_vex(u, w, res);
   copy(w1, w);
   SYMfreeall(w1);
   return OK;
}

/*
 * u is a permutation, not vexillary. The way to the nearest permutation is
 * well known. res is the KL P_{u,w}
 */

INT
calculc(u, w, way, wh, res)
OP              u, w, way, res;
INT             wh;
{
   OP              w1;
   INT             ret;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   w1 = callocobject();
   copy(w, w1);
   ret = deb_tr(u, w, res);

   if (ret == 0)
      calcul2(u, w, way, wh, res);	/* CC */
   copy(w1, w);
   SYMfreeall(w1);
   return OK;
}

/*
 * w is normalized according with u way is a tableau to go to a vexillary
 * permutation and wh is the current index in this tableau. res, the result,
 * is the KL polynom P_{u,w).
 */


INT
calcul2(u, w, way, wh, res)
OP              u, w, way, res;
INT             wh;
{
   signed char     boo = 0, bol = 0;
   unsigned char   barr;
   OP              fc, nb1, nb2, mp;
   OP              ld = callocobject();
   OP              tp = callocobject();
   OP              v = callocobject();
   OP              w2 = callocobject();
   OP              res1 = callocobject();
   OP              res2 = callocobject();
   OP              w1 = callocobject();

   INT             ind, i, ret;
   int             av;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   mp = callocobject();
   copy(u, v);
   copy(w, w2);
   ind = S_V_II(way, wh);

   swap_prm(v, ind);
   swap_prm(w2, ind);
   wh++;
   if (wh == S_V_LI(way))
   {
      if (deb_tr(v, w2, res1) == 0L)	/* CC 19/01/98 */
	 kl_vex(v, w2, res1);
      boo = 1;
   } else
   {
      if (deb_tr(v, w2, res1) == 0L)
      {
	 calcul2(v, w2, way, wh, res1);	/* CC */
      }
   }

   copy(w, w1);
   init(MONOPOLY, res);
   /*
    * ret = debut(v, w, res2);
    */
   /* CC 0898 */
   /**/
   ret = deb2(v, w, ind, res2);
   /**/
   if (ret == 0L)
   {
      if (EQ(w, w2) == TRUE)
      {
	 copy(res1, res2);
	 fc = callocobject();
	 m_skn_mp(cons_eins, cons_eins, NULL, fc);
	 add_apply(cons_eins, fc);
	 mult(fc, res1, res);
	 SYMfreeall(fc);
	 bol = 1;
      } else
      {
	 if (boo == 1)
	 {

	    kl_vex(v, w, res2);
	 } else
	    calcul2(v, w, way, wh, res2);	/* CC */
      }
   }
   copy(w1, w);
   if (bol == 0)
   {
      if (!nullp(res2))
      {
	 fc = callocobject();
	 m_skn_mp(cons_eins, cons_eins, NULL, fc);
	 mult(fc, res2, res);
	 SYMfreeall(fc);
      }
      add_apply(res1, res);
   }
   nb1 = callocobject();
   nb2 = callocobject();

   numberof_inversionen(v, nb1);
   numberof_inversionen(w, nb2);

   if (ret != 2L)
   {
      if (S_I_I(nb1) + 1L < S_I_I(nb2))
      {
	 ret = 0;
	 av = S_P_II(v, 0);
	 for (i = 1; i < ind; i++)
	 {
	    if (av > S_P_II(v, i))
	       break;
	    av = S_P_II(v, i);
	 }
	 if (i == ind)
	 {
	    if (S_P_II(v, ind - 1L) == ordre)
	       ret = 1;
	    else
	    {
	       av = S_P_II(v, i);
	       i++;
	    }
	 } else
	 {
	    i = ind;
	    av = S_P_II(v, i);
	    i++;
	 }
	 if (ret != 1)
	 {
	    /* CC 0798 */

	    if (av == 1L)
	    {
	       if (i == ordre)
		  ret = 1;
	       else
	       {
		  for (; i < ordre; i++)
		  {
		     if (av > S_P_II(v, i))
			break;
		     av = S_P_II(v, i);
		  }
		  if (i == ordre)
		  {
		     if (S_P_II(v, ind - 1L) < S_P_II(v, ind + 1L))
		     {
			b_skn_mp(callocobject(), callocobject(), NULL, mp);
			M_I_I(1L, S_PO_S(mp));
			M_I_I(-1L, S_PO_K(mp));
			if (S_I_I(nb2) <= S_I_I(nb1) + 3L)
			   add_apply(mp, res);
			else
			{
			   fc = callocobject();
			   swap2(v, ind - 1L, ind + 1L);
			   calcul_tr(v, w, res2);
			   mult(res2, mp, fc);
			   add_apply(fc, res);
			   SYMfreeall(fc);
			}
		     }		/* End of else of if((S_P_II(v,ind-1L) <
				 * S_P_II(v, ind+1L)) */
		     ret = 1;
		  }		/* End of if(i==ordre) */
	       }		/* End of else of if(i==ordre) */
	    }			/* End of if(av==1L) */
	 }
	 /*
	  * if(ret==1) {printf("Sortie \n"); print(v); println(w);}
	  */
	 if (ret != 1)
	 {
	    /*
	     * printf("CCC\n"); println(v); println(w);
	     */
	    barr = 0;
	    if (S_I_I(nb2) >= S_I_I(nb1) + 3
		&& (S_I_I(nb2) - S_I_I(nb1)) % 2 == 1)
	    {
	       if (S_O_K(res2) == MONOPOLY)
	       {
		  ld_coef(res2, tp, ld);
		  if (S_I_I(ld) == (S_I_I(nb2) - S_I_I(nb1) - 1) / 2)
		     barr = S_I_I(ld) + 1;
	       }
	    }
	    inter_kl(v, w, way, wh, boo, ind, barr, res1);
	    add_apply(res1, res);
	 }
      }
      /* End of  if(S_I_I(nb1)+1L< S_I_I(nb2)) */
      else if (S_I_I(nb1) + 1L == S_I_I(nb2))
      {
	 b_skn_mp(callocobject(), callocobject(), NULL, mp);
	 M_I_I(1L, S_PO_S(mp));
	 M_I_I(-1L, S_PO_K(mp));
	 add_apply(mp, res);
	 freeself(mp);
      }
   }
   /*
    * bll--;printf("BBB\n bll %d", bll); println(res);
    */


   /*
    * hash_put(u, w, res);
    */
   if (S_I_I(nb1) + 1 < S_I_I(nb2))
      hash_put(u, w, res);
   SYMfreeall(ld);
   SYMfreeall(tp);
   SYMfreeall(mp);
   SYMfreeall(nb1);
   SYMfreeall(nb2);
   SYMfreeall(w1);
   SYMfreeall(w2);
   SYMfreeall(v);
   SYMfreeall(res1);
   SYMfreeall(res2);
   return OK;
}


/*
 * u and w are permutations. res is the Kashdan polynom P_{u,w}
 */

INT
calculm(u, w, res)
OP              u, w, res;
{
   OP              way, vex, pa, w1;
   INT             nb, ret;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   w1 = callocobject();
   copy(w, w1);
   ret = debut(u, w, res);

   if (ret == 0)
   {
      pa = callocobject();
      if (vexillaryp_permutation(u, pa) == TRUE)
      {
	 kl_vex(u, w, res);
	 copy(w1, w);
	 SYMfreeall(w1);
	 SYMfreeall(pa);
	 return OK;
      }
      SYMfreeall(pa);
      way = callocobject();
      vex = callocobject();
      vx_upper(u, way, vex);

      calcul2(u, w, way, 0, res);	/* CC */
      copy(w1, w);
      SYMfreeall(way);
      SYMfreeall(vex);
      SYMfreeall(w1);
      return OK;
   } else
   {
      copy(w1, w);
      SYMfreeall(w1);
      return OK;
   }
}

/*
 * u and w are permutations, with u<=w. res is the Kashdan polynom P_{u,w}
 */

INT
calcul_tr(u, w, res)
OP              u, w, res;
{
   OP              way, vex, pa, w1;
   INT             nb, ret;

   if (!EMPTYP(res))
      init(MONOPOLY, res);
   w1 = callocobject();
   copy(w, w1);
   ret = deb_tr(u, w, res);

   if (ret == 0)
   {
      pa = callocobject();
      if (vexillaryp_permutation(u, pa) == TRUE)
      {
	 kl_vex(u, w, res);
	 copy(w1, w);
	 SYMfreeall(w1);
	 SYMfreeall(pa);
	 return OK;
      }
      SYMfreeall(pa);
      way = callocobject();
      vex = callocobject();
      vx_upper(u, way, vex);

      calcul2(u, w, way, 0, res);	/* CC */
      copy(w1, w);
      SYMfreeall(way);
      SYMfreeall(vex);
      SYMfreeall(w1);
      return OK;
   } else
   {
      copy(w1, w);
      SYMfreeall(w1);
      return OK;
   }
}


/*
 * Frees the hash_table
 */

INT
hash_ende()
{
   INT             i;
   OP             *bch = hash_table;

   for (i = 0L; i < HASH_MAX; i++, bch++)
   {
      if (*bch != NULL)
	 SYMfreeall(*bch);
   }
   return OK;
}

/*
Calcul dans c le polynome de KL P(a,b) avec les conventions de LS 
Le polynome de sortie est de type Monopoly
*/

INT kl2_ls(a,b,c) OP a,b,c;
{
	OP y,z;

	ordre =(unsigned char) S_P_LI(a);
	if(!EMPTYP(c)) freeself(c);
	calculm(a, b, c);
	return OK;
}

/*
Calcul dans c le  polynome de KL P(a,b) avec les conventions de KL
Le polynome de sortie est de type Monopoly
*/

INT kl2(a,b,c) OP a,b,c;
{
	OP y,z;
	int i;
	if(!EMPTYP(c)) freeself(c);
	y=callocobject(); z=callocobject();
	ordre =(unsigned char) S_P_LI(a);
	m_il_p(ordre, y);
	m_il_p(ordre, z);
	for (i = 0L; i < ordre; i++){
		M_I_I(S_P_II(a, ordre - 1L - i), S_P_I(y, i));
		M_I_I(S_P_II(b, ordre - 1L - i), S_P_I(z, i));
	}
	calculm(z, y, c);
	SYMfreeall(y);
	SYMfreeall(z);
	return OK;
}

/*
Calcul dans c le polynome de KL P(a,b) avec les conventions de LS 
Le polynome de sortie est de type Monopoly
*/

INT kl_ls(a,b,c) OP a,b,c;
{
	OP d=callocobject();
	if(!EMPTYP(c)) freeself(c);
	kl2_ls(a,b,d);
	m_mp_v(d,c);
	SYMfreeall(d);
}

/*
Calcul dans c le  polynome de KL P(a,b) avec les conventions de KL
Le polynome de sortie est de type Monopoly
*/

INT kl(a,b,c) OP a,b,c;
{
	OP d=callocobject();
	if(!EMPTYP(c)) freeself(c);
	kl2(a,b,d);
	m_mp_v(d,c);
	SYMfreeall(d);
}

/*
For conviviality
*/

INT formalism(){
	printf("Choose the good formalism\n"
"Type 1	\t\t=> KL's formalism:\n"
 "Schubert variety of dimension 0 associated to the permutation 1 2 ... n\n\n");

printf("Type 2	\t\t=> LS's formalism:\n"
 "Schubert variety of dimension 0 associated to the permutation n n-1 ... 1\n\n");
	return OK;
}

/*
For conviviality
*/

INT branch_formalism(){
	int n;

	scanf("%d", &n);
	switch(n){
		case 1: kl_choice(); break;
		case 2: ls_choice(); break;
		default:  kl_choice(); break;
	}
	return OK;
}


/*
For conviviality
*/

INT menu(){
	printf("To compute KL polynomials,=>\t Type 1\n"
"to compute KL polynomials in a cell =>\t Type 2\n"
"to compute KL polynomial in a cell with some filters =>\t Type 3\n"
"to stop at any moment type <Ctrl-C>\n\n");
	return OK;
}

/*
For conviviality
*/

int moulin1(INT (*f)(OP, OP, OP), int boo){
	OP a=callocobject(), b=callocobject(), c=callocobject();
	while(1){
		scan(PERMUTATION, a);
		scan(PERMUTATION, b);
		f(a, b, c);
		view(a,b,c);
		putchar('\n');
		freeself(a); freeself(b); freeself(c);
	}
	SYMfreeall(a); SYMfreeall(b); SYMfreeall(c);
	return OK;
}

/*
For conviviality
*/

int moulin2(INT (*f)(OP, OP, OP), int boo){
	OP a=callocobject(), b=callocobject(), c=callocobject();
	while(1){
		scan(PERMUTATION, a);
		f(a, b, c);
		if(boo==1) view_vc(a,b,c);
		else  view_vc_ls(a,b,c);
		putchar('\n');
		freeself(a); freeself(b); freeself(c);
	}
	SYMfreeall(a); SYMfreeall(b); SYMfreeall(c);
	return OK;
}

/*
For conviviality
*/

otherchoice(int boo){
	int n;
	printf("To only have KL's polynomials higher than 1 =>\t \t Type 1\n"
"To only have  KL's polynomials of maximal degree =>\t \t Type 2\n"
);
	scanf("%d", &n);
	switch(n){
		case 1: if(boo==1) moulin2(lower_kl_notone, 1);
			else moulin2(upper_kl_notone_ls, 2); break;
		case 2: if(boo==1) moulin2(lower_kl_max, 1);
			else moulin2(upper_kl_max_ls, 2);
	}
	return OK;
}

/*
For conviviality
*/

INT kl_choice(){
	INT n;

	printf("KL's formalism\n");
	menu();
	scanf("%d", &n);
	switch(n){
		case 1: moulin1(kl, 1); break;
		case 2: moulin2(lower_kl,1); break;
		case 3: otherchoice(1); break; 
		default: break;
	}
	return OK;
}

/*
For conviviality
*/

INT ls_choice(){
	int n;
	printf("LS's formalism\n");
	menu();
	scanf("%d", &n);
	switch(n){
		case 1: moulin1(kl_ls, 2); break;
		case 2: moulin2(upper_kl_ls,2); break;
		case 3: otherchoice(2); break; 
		default: break;
	}
	return OK;
}

/*
For conviviality
*/

INT convivial(){
	formalism();
	branch_formalism();
	return OK;
}

/*_______________________________________________________________________*/
