/********************************************************************/
/********************************************************************/
/**                                                                **/
/**                         LINEAR ALGEBRA                         **/
/**                          (first part)                          **/
/**                                                                **/
/**                       copyright Babe Cool                      **/
/**                                                                **/
/********************************************************************/
/********************************************************************/
/* $Id: alglin1.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */

#include "genpari.h"

/*******************************************************************/
/*                                                                 */
/*                         TRANSPOSE                               */
/*                                                                 */
/*******************************************************************/

GEN
gtrans(GEN x)
{
  long i,j,lx,dx, tx=typ(x);
  GEN y,p1;

  if (! is_matvec_t(tx)) err(typeer,"gtrans");
  switch(tx)
  {
    case t_VEC:
      y=gcopy(x); settyp(y,t_COL); break;

    case t_COL:
      y=gcopy(x); settyp(y,t_VEC); break;

    case t_MAT:
      lx=lg(x); if (lx==1) return cgetg(1,t_MAT);
      dx=lg(x[1]); y=cgetg(dx,tx);
      for (i=1; i<dx; i++)
      {
	p1=cgetg(lx,t_COL); y[i]=(long)p1;
	for (j=1; j<lx; j++) p1[j]=lcopy(gcoeff(x,i,j));
      }
      break;

    default: y=gcopy(x); break;
  }
  return y;
}

/*******************************************************************/
/*                                                                 */
/*                    CONCATENATION & EXTRACTION                   */
/*                                                                 */
/*******************************************************************/

static GEN
strconcat(GEN x, GEN y)
{
  long flx=0,fly=0,l;
  char *sx,*sy,*str;

  if (typ(x)==t_STR) sx = GSTR(x); else { flx=1; sx = GENtostr(x); }
  if (typ(y)==t_STR) sy = GSTR(y); else { fly=1; sy = GENtostr(y); }
  l = strlen(sx) + strlen(sy);
  str = gpmalloc(l+1);
  strcpy(str,sx);
  strcat(str,sy);
  x = strtoGEN(str,l);
  if (flx) free(sx);
  if (fly) free(sy);
  free(str); return x;
}

GEN
concatsp(GEN x, GEN y)
{
  long tx=typ(x),ty=typ(y),lx=lg(x),ly=lg(y),i;
  GEN z,p1;

  if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
  if (tx==t_STR  || ty==t_STR)  return strconcat(x,y);

  if (tx==t_MAT && lx==1)
  {
    if (ty!=t_VEC || ly==1) return gtomat(y);
    err(concater);
  }
  if (ty==t_MAT && ly==1)
  {
    if (tx!=t_VEC || lx==1) return gtomat(x);
    err(concater);
  }

  if (! is_matvec_t(tx))
  {
    if (! is_matvec_t(ty))
    {
      z=cgetg(3,t_VEC); z[1]=(long)x; z[2]=(long)y;
      return z;
    }
    z=cgetg(ly+1,ty); 
    if (ty != t_MAT) p1 = x;
    else
    {
      if (lg(y[1])!=2) err(concater);
      p1=cgetg(2,t_COL); p1[1]=(long)x;
    }
    for (i=2; i<=ly; i++) z[i]=y[i-1];
    z[1]=(long)p1; return z;
  }
  if (! is_matvec_t(ty))
  {
    z=cgetg(lx+1,tx); 
    if (tx != t_MAT) p1 = y;
    else
    {
      if (lg(x[1])!=2) err(concater);
      p1=cgetg(2,t_COL); p1[1]=(long)y;
    }
    for (i=1; i<lx; i++) z[i]=x[i];
    z[lx]=(long)p1; return z;
  }

  if (tx == ty)
  {
    if (tx == t_MAT && lg(x[1]) != lg(y[1])) err(concater);
    z=cgetg(lx+ly-1,tx);
    for (i=1; i<lx; i++) z[i]=x[i];
    for (i=1; i<ly; i++) z[lx+i-1]=y[i];
    return z;
  }

  switch(tx)
  {
    case t_VEC:
      switch(ty)
      {
	case t_COL:
	  if (lx<=2) return (lx==1)? y: concatsp((GEN) x[1],y);
          if (ly>=3) break;
          return (ly==1)? x: concatsp(x,(GEN) y[1]);
	case t_MAT:
	  z=cgetg(ly,ty); if (lx != ly) break;
	  for (i=1; i<ly; i++) z[i]=(long)concatsp((GEN) x[i],(GEN) y[i]);
          return z;
      }
      break;

    case t_COL:
      switch(ty)
      {
	case t_VEC:
	  if (lx<=2) return (lx==1)? y: concatsp((GEN) x[1],y);
	  if (ly>=3) break;
	  return (ly==1)? x: concatsp(x,(GEN) y[1]);
	case t_MAT:
	  if (lx != lg(y[1])) break;
	  z=cgetg(ly+1,ty); z[1]=(long)x;
	  for (i=2; i<=ly; i++) z[i]=y[i-1];
          return z;
      }
      break;

    case t_MAT:
      switch(ty)
      {
	case t_VEC:
	  z=cgetg(lx,tx); if (ly != lx) break;
	  for (i=1; i<lx; i++) z[i]=(long)concatsp((GEN) x[i],(GEN) y[i]);
          return z;
	case t_COL:
	  if (ly != lg(x[1])) break;
	  z=cgetg(lx+1,tx); z[lx]=(long)y;
	  for (i=1; i<lx; i++) z[i]=x[i];
          return z;
      }
      break;
  }
  err(concater);
  return NULL; /* not reached */
}

GEN
concat(GEN x, GEN y)
{
  long tx=typ(x),ty=typ(y),lx=lg(x),ly=lg(y),i;
  GEN z,p1;

  if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
  if (tx==t_STR  || ty==t_STR)  return strconcat(x,y);

  if (tx==t_MAT && lx==1)
  {
    if (ty!=t_VEC || ly==1) return gtomat(y);
    err(concater);
  }
  if (ty==t_MAT && ly==1)
  {
    if (tx!=t_VEC || lx==1) return gtomat(x);
    err(concater);
  }

  if (! is_matvec_t(tx))
  {
    if (! is_matvec_t(ty))
    {
      z=cgetg(3,t_VEC); z[1]=lcopy(x); z[2]=lcopy(y);
      return z;
    }
    z=cgetg(ly+1,ty); 
    if (ty != t_MAT) p1 = gcopy(x);
    else
    {
      if (lg(y[1])!=2) err(concater);
      p1=cgetg(2,t_COL); p1[1]=lcopy(x);
    }
    for (i=2; i<=ly; i++) z[i]=lcopy((GEN) y[i-1]);
    z[1]=(long)p1; return z;
  }
  if (! is_matvec_t(ty))
  {
    z=cgetg(lx+1,tx); 
    if (tx != t_MAT) p1 = gcopy(y);
    else
    {
      if (lg(x[1])!=2) err(concater);
      p1=cgetg(2,t_COL); p1[1]=lcopy(y);
    }
    for (i=1; i<lx; i++) z[i]=lcopy((GEN) x[i]);
    z[lx]=(long)p1; return z;
  }

  if (tx == ty)
  {
    if (tx == t_MAT && lg(x[1]) != lg(y[1])) err(concater);
    z=cgetg(lx+ly-1,tx);
    for (i=1; i<lx; i++) z[i]=lcopy((GEN) x[i]);
    for (i=1; i<ly; i++) z[lx+i-1]=lcopy((GEN) y[i]);
    return z;
  }

  switch(tx)
  {
    case t_VEC:
      switch(ty)
      {
	case t_COL:
	  if (lx<=2) return (lx==1)? gcopy(y): concat((GEN) x[1],y);
          if (ly>=3) break;
          return (ly==1)? gcopy(x): concat(x,(GEN) y[1]);
	case t_MAT:
	  z=cgetg(ly,ty); if (lx != ly) break;
	  for (i=1; i<ly; i++) z[i]=lconcat((GEN) x[i],(GEN) y[i]);
          return z;
      }
      break;

    case t_COL:
      switch(ty)
      {
	case t_VEC:
	  if (lx<=2) return (lx==1)? gcopy(y): concat((GEN) x[1],y);
	  if (ly>=3) break;
	  return (ly==1)? gcopy(x): concat(x,(GEN) y[1]);
	case t_MAT:
	  if (lx != lg(y[1])) break;
	  z=cgetg(ly+1,ty); z[1]=lcopy(x);
	  for (i=2; i<=ly; i++) z[i]=lcopy((GEN) y[i-1]);
          return z;
      }
      break;

    case t_MAT:
      switch(ty)
      {
	case t_VEC:
	  z=cgetg(lx,tx); if (ly != lx) break;
	  for (i=1; i<lx; i++) z[i]=lconcat((GEN) x[i],(GEN) y[i]);
          return z;
	case t_COL:
	  if (ly != lg(x[1])) break;
	  z=cgetg(lx+1,tx); z[lx]=lcopy(y);
	  for (i=1; i<lx; i++) z[i]=lcopy((GEN) x[i]);
          return z;
      }
      break;
  }
  err(concater);
  return NULL; /* not reached */
}

GEN
extract(GEN x, GEN l)
{
  long av,i,j, tl = typ(l), tx = typ(x), lx = lg(x);
  GEN y;

  if (! is_matvec_t(tx)) err(typeer,"extract");
  if (tl==t_INT)
  {
    /* extraction des composantes de x suivants les bits du masque l */
    if (!signe(l)) return cgetg(1,tx);
    av=avma; y = (GEN) gpmalloc(lx*sizeof(long));
    i = j = 1; while (!mpodd(l)) { l=shifti(l,-1); i++; }
    while (signe(l) && i<lx)
    {
      if (mod2(l)) y[j++] = x[i];
      i++; l=shifti(l,-1);
    }
    if (signe(l)) err(talker,"mask too large in vecextract");
    y[0] = evaltyp(tx) | evallg(j);
    avma=av; x = gcopy(y); free(y); return x;
  }

  if (is_vec_t(tl))
  {
    long ll=lg(l); y=cgetg(ll,tx);
    for (i=1; i<ll; i++)
    {
      j = itos((GEN) l[i]);
      if (j>=lx || j<=0) err(talker,"no such component in vecextract");
      y[i] = lcopy((GEN) x[j]);
    }
    return y;
  }
  err(talker,"incorrect mask in vecextract");
  return NULL; /* not reached */
}

GEN
matextract(GEN x, GEN l1, GEN l2)
{
  long av,tetpil;

  if (typ(x)!=t_MAT) err(typeer,"matextract");
  av=avma; x = extract(gtrans(extract(x,l2)),l1);
  tetpil=avma; return gerepile(av,tetpil,gtrans(x));
}

GEN
extract0(GEN x, GEN l1, GEN l2)
{
  if (! l2) return extract(x,l1);
  return matextract(x,l1,l2);
}

/*******************************************************************/
/*                                                                 */
/*                     SCALAR-MATRIX OPERATIONS                    */
/*                                                                 */
/*******************************************************************/

/* create the square nxn matrix equal to z*Id */
static GEN
gscalmat_proto(GEN z, GEN myzero, long n)
{
  long i,j;
  GEN y = cgetg(n+1,t_MAT);
  for (i=1; i<=n; i++)
  {
    y[i]=lgetg(n+1,t_COL);
    for (j=1; j<=n; j++)
      coeff(y,j,i) = (i==j)? (long)z: (long)myzero;
  }
  return y;
}

GEN
gscalmat(GEN x, long n) { return gscalmat_proto(gcopy(x),gzero,n); }

GEN
gscalsmat(long x, long n) { return gscalmat_proto(stoi(x),gzero,n); }

GEN
idmat(long n) { return gscalmat_proto(gun,gzero,n); }

GEN
idmat_intern(long n,GEN myun,GEN z) { return gscalmat_proto(myun,z,n); }

GEN
gscalcol_proto(GEN z, GEN myzero, long n)
{
  GEN y = cgetg(n+1,t_COL);
  long i;

  if (n)
  {
    y[1]=(long)z;
    for (i=2; i<=n; i++) y[i]=(long)myzero;
  }
  return y;
}

GEN
zerocol(long n) { return gscalcol_proto(gzero,gzero,n); }

GEN
gscalcol(GEN x, long n) { return gscalcol_proto(gcopy(x),gzero,n); }

GEN
gscalcol_i(GEN x, long n) { return gscalcol_proto(x,gzero,n); }

GEN
gtomat(GEN x)
{
  long tx=typ(x),lx,i;
  GEN y,p1;

  if (! is_matvec_t(tx))
  {
    y=cgetg(2,t_MAT); p1=cgetg(2,t_COL); y[1]=(long)p1;
    p1[1]=lcopy(x); return y;
  }
  switch(tx)
  {
    case t_VEC:
      lx=lg(x); y=cgetg(lx,t_MAT);
      for (i=1; i<lx; i++)
      {
	p1=cgetg(2,t_COL); y[i]=(long)p1;
	p1[1]=lcopy((GEN) x[i]);
      }
      break;
    case t_COL:
      y=cgetg(2,t_MAT); y[1]=lcopy(x); break;
    case t_MAT:
      y=gcopy(x); break;
  }
  return y;
}

long
isdiagonal(GEN x)
{
  long nco,i,j;

  if (typ(x)!=t_MAT) err(typeer,"isdiagonal");
  nco=lg(x)-1; if (!nco) return 1;
  if (nco != lg(x[1])-1) return 0;

  for (j=1; j<=nco; j++)
  {
    GEN *col = (GEN*) x[j];
    for (i=1; i<=nco; i++)
      if (i!=j && !gcmp0(col[i])) return 0;
  }
  return 1;
}

/* create the diagonal matrix, whose diagonal is given by x */
GEN
diagonal(GEN x)
{
  long i,j,lx,tx=typ(x);
  GEN y,p1;

  if (! is_matvec_t(tx)) return gscalmat(x,1);
  if (tx==t_MAT)
  {
    if (isdiagonal(x)) return gcopy(x);
    err(talker,"incorrect object in diagonal");
  }
  lx=lg(x); y=cgetg(lx,t_MAT);
  for (j=1; j<lx; j++)
  {
    p1=cgetg(lx,t_COL); y[j]=(long)p1;
    for (i=1; i<lx; i++)
      p1[i] = (i==j)? lcopy((GEN) x[i]): zero;
  }
  return y;
}

/* compute m*diagonal(d) */
GEN
matmuldiagonal(GEN m, GEN d)
{
  long j=typ(d),lx=lg(m);
  GEN y;

  if (typ(m)!=t_MAT) err(typeer,"matmuldiagonal");
  if (! is_vec_t(j) || lg(d)!=lx)
    err(talker,"incorrect vector in matmuldiagonal");
  y=cgetg(lx,t_MAT);
  for (j=1; j<lx; j++) y[j] = lmul((GEN) d[j],(GEN) m[j]);
  return y;
}

/* compute m*n assuming the result is a diagonal matrix */
GEN
matmultodiagonal(GEN m, GEN n)
{
  long lx,i,j;
  GEN s,y;

  if (typ(m)!=t_MAT || typ(n)!=t_MAT) err(typeer,"matmultodiagonal");
  lx=lg(n); y=idmat(lx-1);
  for (i=1; i<lx; i++)
  {
    s = gzero;
    for (j=1; j<lx; j++)
      s = gadd(s,gmul(gcoeff(m,i,j),gcoeff(n,j,i)));
    coeff(y,i,i) = (long)s;
  }
  return y;
}

/*******************************************************************/
/*                                                                 */
/*                    ADDITION SCALAR + MATRIX                     */
/*                                                                 */
/*******************************************************************/

/* create the square matrix x*Id + y */
GEN
gaddmat(GEN x, GEN y)
{
  long ly,dy,i,j;
  GEN z;

  ly=lg(y); if (ly==1) err(gadderf,"Scalar","t_MAT");
  dy=lg(y[1]);
  if (typ(y)!=t_MAT || ly!=dy) err(mattype1,"gaddmat");
  z=cgetg(ly,t_MAT);
  for (i=1; i<ly; i++)
  {
    z[i]=lgetg(dy,t_COL);
    for (j=1; j<dy; j++)
      coeff(z,j,i) = i==j? ladd(x,gcoeff(y,j,i)): lcopy(gcoeff(y,j,i));
  }
  return z;
}

/*******************************************************************/
/*                                                                 */
/*                       Solve A*X=B (Gauss pivot)                 */
/*                                                                 */
/*******************************************************************/
static GEN
check_b(GEN b, long nbli)
{
  GEN col;
  if (!b) return idmat(nbli);
  b = dummycopy(b);
  col = (typ(b) == t_MAT)? (GEN)b[1]: b;
  if (nbli == lg(col)-1) return b;
  err(talker,"incompatible matrix dimensions in gauss"); 
  return NULL; /* not reached */
}

GEN
gauss_get_col(GEN a, GEN b, GEN p, long nbli)
{
  GEN m, u=cgetg(nbli+1,t_COL);
  long i,j;

  u[nbli] = ldiv((GEN) b[nbli],p);
  for (i=nbli-1; i>0; i--)
  {
    m = gneg((GEN)b[i]);
    for (j=i+1; j<=nbli; j++)
      m = gadd(m, gmul(gcoeff(a,i,j),(GEN) u[j]));
    u[i] = ldiv(gneg(m), gcoeff(a,i,i));
  }
  return u;
}

/* Gauss pivot.
 * Compute a^(-1)*b, where nblig(a) = nbcol(a) = nblig(b).
 * b is a matrix or column vector, NULL meaning: take the identity matrix
 * Be careful, if a or b is empty, the result is the empty matrix...
 */
GEN
gauss(GEN a, GEN b)
{
  long inexact,ismat,nbli,nbco,i,j,k,av,av1,tetpil,lim;
  GEN p,m,u;
  /* nbli: nb lines of b = nb columns of a */
  /* nbco: nb columns of b (if matrix) */

  if (typ(a)!=t_MAT) err(mattype1,"gauss");
  if (b && typ(b)!=t_COL && typ(b)!=t_MAT) err(typeer,"gauss");
  if (lg(a) == 1 || (b && lg(b)==1))
  {
    if (DEBUGLEVEL)
      err(warner,"in Gauss lg(a)=%ld lg(b)=%ld",lg(a),b?lg(b):-1);
    return cgetg(1,t_MAT);
  }
  av=avma; lim=(bot+av)>>1;
  nbli = lg(a)-1; if (nbli!=lg(a[1])-1) err(mattype1,"gauss");
  a = dummycopy(a);
  b = check_b(b,nbli);
  nbco = lg(b)-1;
  inexact = isinexactreal(a);
  ismat   = (typ(b)==t_MAT);
  if(DEBUGLEVEL>4)
    fprintferr("Entering gauss with inexact=%ld ismat=%ld\n",inexact,ismat);

  for (i=1; i<nbli; i++)
  {
    long exchange;

    /* k is the line where we find the pivot */
    p=gcoeff(a,i,i); k=i;
    if (inexact) /* maximal pivot */
    {
      GEN p1, p2;
      av1 = avma;
      p2 = gabs(p,DEFAULTPREC);
      for (j=i+1; j<=nbli; j++)
      {
        p1 = gabs(gcoeff(a,j,i),DEFAULTPREC);
        if (gcmp(p1,p2)>0) { p2=p1; k=j; }
      }
      if (gcmp0(p2)) err(matinv1);
      exchange = (k > i);
      avma = av1;
    }
    else /* first non-zero pivot */
    {
      exchange = gcmp0(p);
      if (exchange)
      {
        do k++; while (k<=nbli && gcmp0(gcoeff(a,k,i)));
        if (k>nbli) err(matinv1);
      }
    }

    /* exchange==1 if k<>i, we exchange the lines s.t. k=i */
    if (exchange)
    {
      for (j=i; j<=nbli; j++)
      {
	u = gcoeff(a,i,j);
	coeff(a,i,j) = coeff(a,k,j);
	coeff(a,k,j) = (long)u;
      }
      if (ismat) for (j=1; j<=nbco; j++)
      {
	u = gcoeff(b,i,j);
	coeff(b,i,j) = coeff(b,k,j);
	coeff(b,k,j) = (long)u;
      }
      else
      {
        u=(GEN)b[i]; b[i]=b[k]; b[k]=(long)u;
      }
      p = gcoeff(a,i,i);
    }

    for (k=i+1; k<=nbli; k++)
    {
      m=gcoeff(a,k,i);
      if (!gcmp0(m))
      {
	m = gneg(gdiv(m,p));
	for (j=i+1; j<=nbli; j++)
	{
	  u = gmul(m,gcoeff(a,i,j));
	  coeff(a,k,j) = ladd(gcoeff(a,k,j),u);
	}
	if (ismat) for (j=1; j<=nbco; j++)
	{
	  u = gmul(m,gcoeff(b,i,j));
	  coeff(b,k,j) = ladd(gcoeff(b,k,j),u);
	}
	else
	{
	  u = gmul(m,(GEN) b[i]);
	  b[k] = ladd((GEN) b[k],u);
	}
      }
    }
    if (low_stack(lim, (bot+av)>>1))
    {
      GEN *gptr[2]; 
      if(DEBUGMEM>1) err(warnmem,"gauss");
      gptr[0]=&a; gptr[1]=&b;
      gerepilemany(av,gptr,2);
    }
  }

  if(DEBUGLEVEL>4) fprintferr("Solving the triangular system\n");
  p=gcoeff(a,nbli,nbli);
  if (!inexact && gcmp0(p)) err(matinv1);
  if (!ismat) u = gauss_get_col(a,b,p,nbli);
  else
  {
    u=cgetg(nbco+1,t_MAT);
    for (j=1; j<=nbco; j++)
      u[j] = (long)gauss_get_col(a,(GEN)b[j],p,nbli);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(u));
}

/* x a matrix with integer coefficients. Return a multiple of the determinant
 * of the lattice generated by the columns of x (to be used with hnfmod)
 */
GEN
detint(GEN x)
{
  GEN pass,c,v,det1,piv,pivprec,vi,p1;
  long i,j,k,rg,n,m,m1,av=avma,av1,tetpil,lim,cm=0;

  if (typ(x)!=t_MAT) err(typeer,"detint");
  n=lg(x)-1; if (!n) return gun;
  m1=lg(x[1]); m=m1-1; lim=(av+bot)>>1;
  c=cgeti(m1); for (k=1; k<=m; k++) c[k]=0;
  av1=avma; pass=cgetg(m1,t_MAT);
  for (j=1; j<=m; j++)
  {
    p1=cgetg(m1,t_COL); pass[j]=(long)p1;
    for (i=1; i<=m; i++) p1[i]=zero;
  }
  v=cgetg(m1,t_COL);
  det1=gzero; piv=pivprec=gun; 
  for (rg=0,k=1; k<=n; k++)
  {
    long t = 0;
    for (i=1; i<=m; i++)
      if (!c[i])
      {
	vi=mulii(piv,gcoeff(x,i,k));
	for (j=1; j<=m; j++)
	  if (c[j]) vi=addii(vi,mulii(gcoeff(pass,i,j),gcoeff(x,j,k)));
	v[i]=(long)vi; if (!t && signe(vi)) t=i;
      }
    if (t)
    {
      pivprec = piv;
      if (rg == m-1)
        { det1=mppgcd((GEN)v[t],det1); cm=1; c[t]=0; }
      else
      {
	rg++; piv=(GEN)v[t]; c[t]=k;
	for (i=1; i<=m; i++)
	  if (!c[i])
	  {
	    for (j=1; j<=m; j++)
	      if (c[j] && j!=t)
	      {
	        p1=subii(mulii(piv,gcoeff(pass,i,j)),
	 	 	 mulii((GEN)v[i], gcoeff(pass,t,j)));
	        coeff(pass,i,j) = rg>1? ldivii(p1,pivprec): (long)p1;
	      }
	    coeff(pass,i,t) = lnegi((GEN)v[i]);
	  }
      }
    }
    if (low_stack(lim, (av+bot)>>1))
    {
      GEN *gptr[5];
      if(DEBUGMEM>1) err(warnmem,"detint");
      gptr[0]=&det1; gptr[1]=&piv; gptr[2]=&pivprec;
      gptr[3]=&pass; gptr[4]=&v; gerepilemany(av1,gptr,5);
    }
  }
  if (cm) { tetpil=avma; return gerepile(av,tetpil,absi(det1)); }
  avma=av; return gzero;
}

/*******************************************************************/
/*                                                                 */
/*                    KERNEL of an m x n matrix                    */
/*          return n - rk(x) linearly independant vectors          */
/*                                                                 */
/*******************************************************************/

/* x has INTEGER coefficients */
GEN
keri(GEN x)
{
  GEN c,d,y,p,pp;
  long i,j,k,r,t,n,m,av,avmaold,tetpil,lim;

  if (typ(x)!=t_MAT) err(typeer,"keri");
  n=lg(x)-1; if (!n) return cgetg(1,t_MAT);

  avmaold=avma; m=lg(x[1])-1; r=0;
  pp=cgetg(n+1,t_COL);
  x=dummycopy(x); p=gun;
  c=cgeti(m+1); for (k=1; k<=m; k++) c[k]=0;
  d=cgeti(n+1); av=avma; lim=(av+bot)>>1;
  for (k=1; k<=n; k++)
  {
    j=1;
    while (j<=m && (c[j] || !signe(gcoeff(x,j,k))) ) j++;
    if (j>m)
    { 
      r++; d[k]=0;
      for(j=1; j<k; j++)
	if (d[j]) coeff(x,d[j],k) = lclone(gcoeff(x,d[j],k));
      pp[k]=lclone(p);
    }
    else 
    {
      GEN p0 = p;
      long av1, av2;
      
      c[j]=k; d[k]=j; p = gcoeff(x,j,k);

      for (t=1; t<=m; t++)
	if (t!=j)
	{
	  GEN q=gcoeff(x,t,k), p1,p2;
	  for (i=k+1; i<=n; i++)
	  {
	    av1=avma;
	    p1=mulii(q,gcoeff(x,j,i));
	    p2=mulii(p,gcoeff(x,t,i));
	    p1=subii(p2,p1); av2=avma; 
	    coeff(x,t,i) = lpile(av1,av2,divii(p1,p0));
	  }
	  if (low_stack(lim, (av+bot)>>1))
          {
            long u, dec, l1;
            if (DEBUGMEM>1 || DEBUGLEVEL>4)
              fprintferr("gerepile in keri. k=%ld, n=%ld\n",k,n);
 
            av1=avma;
            for (u=t+1; u<=m; u++)
              coeff(x,u,k) = lcopy(gcoeff(x,u,k));
            for (i=k+1; i<=n; i++)
              for (u=1; u<=m; u++)
                coeff(x,u,i) = lcopy(gcoeff(x,u,i));
	    p=gcopy(p);
 
            dec = lpile(av,av1,0);
	    p = (GEN) ((long)p + dec);
            for (u=t+1; u<=m; u++)
            {
              l1=coeff(x,u,k);
              if (l1<av && l1>=bot) coeff(x,u,k)+=dec;
            }
            for (i=k+1; i<=n; i++)
              for (u=1; u<=m; u++)
              {
                l1=coeff(x,u,i);
                if (l1<av && l1>=bot) coeff(x,u,i)+=dec;
              }
          }
	}
    }
  }
  if (!r) { avma=avmaold; y=cgetg(1,t_MAT); return y; }

  /* non trivial kernel */
  tetpil=avma; y=cgetg(r+1,t_MAT);
  for (j=k=1; j<=r; j++,k++)
  {
    p = cgetg(n+1, t_COL);
    y[j]=(long)p; while (d[k]) k++;
    for (i=1; i<k; i++)
      if (d[i])
      {
	c=gcoeff(x,d[i],k);
	p[i] = (long) forcecopy(c); killbloc(c);
      }
      else
	p[i] = zero;
    p[k]=lnegi((GEN)pp[k]); killbloc((GEN)pp[k]);
    for (i=k+1; i<=n; i++) p[i]=zero;
  }
  return gerepile(avmaold,tetpil,y);
}

GEN
deplin(GEN x)
{
  long i,j,k,t, nc=lg(x)-1, nl=lg(x[1])-1, av=avma;
  GEN y,q, c=cgeti(nl+1), l=cgeti(nc+1), d=cgetg(nl+1,t_VEC);

  x=dummycopy(x);
  for (i=1; i<=nl; i++) { d[i]=un; c[i]=0; }
  k=1; t=1;
  while (t<=nl && k<=nc)
  {
    for (j=1; j<k; j++)
     for (i=1; i<=nl; i++)
      if (i!=l[j])
       coeff(x,i,k)=lsub(gmul((GEN) d[j],gcoeff(x,i,k)),
                         gmul(gcoeff(x,i,j),gcoeff(x,l[j],k)));
    t=1;
    while ( t<=nl && (c[t] || gcmp0(gcoeff(x,t,k))) ) t++;
    if (t<=nl)
    {
      d[k]=coeff(x,t,k);
      c[t]=k; l[k++]=t;
    }
  }
  if (k>nc)
  {
    avma=av; y=cgetg(nc+1,t_COL);
    for (j=1; j<=nc; j++) y[j]=zero;
    return y;
  }
  y=cgetg(nc+1,t_COL);
  y[1]=(k>1)? coeff(x,l[1],k): un;
  for (q=gun,j=2; j<k; j++)
  {
    q=gmul(q,(GEN) d[j-1]);
    y[j]=lmul(gcoeff(x,l[j],k),q);
  }
  if (k>1) y[k]=lneg(gmul(q,(GEN) d[k-1]));
  for (j=k+1; j<=nc; j++) y[j]=zero;
  d=content(y); t=avma;
  return gerepile(av,t,gdiv(y,d));
}

/*******************************************************************/
/*                                                                 */
/*         GAUSS REDUCTION OF MATRICES  (m lines x n cols)         */
/*           (kernel, image, complementary image, rank)            */
/*                                                                 */
/*******************************************************************/

static
long get_prec(GEN x, long prec, GEN *ptr)
{
  GEN eps;
  long e,pr;

  if (!prec)
  {
    if (!isinexactreal(x)) return 0;
    prec = DEFAULTPREC;
  }
  pr=gprecision(x);
  if (!pr) return 0;
  prec = max(prec,pr);

  eps=cgetr(3); eps[2]=HIGHBIT;
  e = BITS_IN_LONG - bit_accuracy(prec);
  eps[1] = evalsigne(1) | evalexpo(e);
  *ptr=eps; return prec;
}

/* return the transform of x under a standard Gauss pivot. r = dim ker(x).
 * d[k] contains the index of the first non-zero pivot in column k
 */
static GEN
gauss_pivot_keep(GEN x, long prec, GEN *dd, long *rr)
{
  GEN c,d,p,mun,eps;
  long i,j,k,r,t,n,m,av,av1,lim;

  if (typ(x)!=t_MAT) err(typeer,"gauss_pivot");
  n=lg(x)-1; if (!n) { *dd=NULL; *rr=0; return cgetg(1,t_MAT); }

  prec=get_prec(x,prec,&eps); m=lg(x[1])-1; r=0;
  x=dummycopy(x); mun=negi(gun);
  c=cgeti(m+1); for (k=1; k<=m; k++) c[k]=0;
  d=(GEN)gpmalloc((n+1)*sizeof(long)); 
  av=avma; lim=(av+bot)>>1;
  for (k=1; k<=n; k++)
  {
    j=1;
    if (prec)
      while (j<=m && (c[j] || gcmp(gabs(gcoeff(x,j,k),prec),eps) < 0))
        j++;
    else
      while (j<=m && (c[j] || gcmp0(gcoeff(x,j,k))))
        j++;

    if (j>m)
    { 
      r++; d[k]=0;
      for(j=1; j<k; j++)
        if (d[j]) coeff(x,d[j],k) = lclone(gcoeff(x,d[j],k));
    }
    else
    {
      p = gdiv(mun,gcoeff(x,j,k));
      c[j]=k; d[k]=j; coeff(x,j,k)=(long)mun;
      for (i=k+1; i<=n; i++)
	coeff(x,j,i)=lmul(p,gcoeff(x,j,i));

      for (t=1; t<=m; t++)
      {
	if (t!=j)
	{
	  p=gcoeff(x,t,k); coeff(x,t,k)=zero;
	  for (i=k+1; i<=n; i++)
	    coeff(x,t,i) = ladd(gcoeff(x,t,i),gmul(p,gcoeff(x,j,i)));
	}
        if (low_stack(lim, (av+bot)>>1))
        {
          long u,dec,l1;
          if (DEBUGMEM>1 || DEBUGLEVEL>4)
            fprintferr("gerepile in gauss_pivot. k=%ld, n=%ld\n",k,n);
            
          av1=avma; 
          for (u=t+1; u<=m; u++)
            coeff(x,u,k) = lcopy(gcoeff(x,u,k));
          for (i=k+1; i<=n; i++)
            for (u=1; u<=m; u++)
              coeff(x,u,i) = lcopy(gcoeff(x,u,i));

          dec = lpile(av,av1,0);
          for (u=t+1; u<=m; u++)
          {
            l1=coeff(x,u,k);
            if (l1<av && l1>=bot) coeff(x,u,k)+=dec;
          }
          for (i=k+1; i<=n; i++)
            for (u=1; u<=m; u++)
            {
              l1=coeff(x,u,i);
              if (l1<av && l1>=bot) coeff(x,u,i)+=dec;
            }
        }
      }
    }		
  }
  *dd=d; *rr=r; return x;
}

/* r = dim ker(x).
 * d[k] contains the index of the first non-zero pivot in column k
 */
static void
gauss_pivot(GEN x, long prec, GEN *dd, long *rr)
{
  GEN c,d,mun,eps,p;
  long i,j,k,r,t,n,m,av,av1,lim;

  if (typ(x)!=t_MAT) err(typeer,"gauss_pivot");
  n=lg(x)-1; if (!n) { *dd=NULL; *rr=0; return; }

  prec=get_prec(x,prec,&eps); m=lg(x[1])-1; r=0;
  x=dummycopy(x); mun=negi(gun);
  c=cgeti(m+1); for (k=1; k<=m; k++) c[k]=0;
  d=(GEN)gpmalloc((n+1)*sizeof(long)); av=avma; lim=(av + 2*bot)/3;
  for (k=1; k<=n; k++)
  {
    j=1;
    if (prec)
      while (j<=m && (c[j] || gcmp(gabs(gcoeff(x,j,k),prec),eps) < 0))
        j++;
    else
      while (j<=m && (c[j] || gcmp0(gcoeff(x,j,k))))
        j++;

    if (j>m) { r++; d[k]=0; }
    else
    {
      c[j]=k; d[k]=j; p = gdiv(mun,gcoeff(x,j,k));
      for (i=k+1; i<=n; i++)
	coeff(x,j,i) = lmul(p,gcoeff(x,j,i));

      for (t=1; t<=m; t++) if (!c[t]) /* no pivot on that line yet */
      {
        p=gcoeff(x,t,k); coeff(x,t,k)=zero;
        for (i=k+1; i<=n; i++)
          coeff(x,t,i) = ladd(gcoeff(x,t,i), gmul(p,gcoeff(x,j,i)));

        if (low_stack(lim, (av + 2*bot)/3))
        {
          long u,dec,l1;
          if (DEBUGMEM>1 || DEBUGLEVEL>4)
            fprintferr("gerepile in gauss_pivot. k=%ld, n=%ld\n",k,n);
            
          av1=avma; 
          for (u=t+1; u<=m; u++)
            if (u==j || !c[u])
              coeff(x,u,k) = lcopy(gcoeff(x,u,k));
          for (u=1; u<=m; u++)
            if (u==j || !c[u])
              for (i=k+1; i<=n; i++)
                coeff(x,u,i) = lcopy(gcoeff(x,u,i));

          dec = lpile(av,av1,0);
          for (u=t+1; u<=m; u++)
            if (u==j || !c[u])
            {
              l1=coeff(x,u,k);
              if (l1<av && l1>=bot) coeff(x,u,k)+=dec;
            }
          for (u=1; u<=m; u++)
            if (u==j || !c[u])
              for (i=k+1; i<=n; i++)
              {
                l1=coeff(x,u,i);
                if (l1<av && l1>=bot) coeff(x,u,i)+=dec;
              }
        }
      }
      for (i=k; i<=n; i++) coeff(x,j,i) = zero; /* dummy */
    }		
  }
  *dd=d; *rr=r;
}

static GEN
ker0(GEN x, long prec, GEN myzero, GEN myun)
{
  GEN d,y;
  long i,j,k,r,n, av = avma, tetpil;

  x=gauss_pivot_keep(x,prec,&d,&r);
  if (!r)
  { 
    avma=av; if (d) free(d);
    return cgetg(1,t_MAT);
  }
  n = lg(x)-1; tetpil=avma; y=cgetg(r+1,t_MAT);
  for (j=k=1; j<=r; j++,k++)
  {
    GEN p = cgetg(n+1,t_COL);

    y[j]=(long)p; while (d[k]) k++;
    for (i=1; i<k; i++)
      if (d[i])
      {
	GEN p1=gcoeff(x,d[i],k);
	p[i] = (long)forcecopy(p1); killbloc(p1);
      }
      else
	p[i] = (long)myzero;
    p[k]=(long)myun; for (i=k+1; i<=n; i++) p[i]=(long)myzero;
  }
  free(d); return gerepile(av,tetpil,y);
}

GEN
ker(GEN x) /* Programme pour types exacts */
{
  return ker0(x,0,gzero,gun);
}

GEN
matker0(GEN x,long flag)
{
  return (flag)? keri(x): ker(x);
}

GEN
ker_spec(GEN x,GEN myzero,GEN myun)
{
  return ker0(x,0,myzero,myun);
}

static GEN
image0(GEN x, long prec)
{
  GEN d,y;
  long j,k,r, av = avma;

  gauss_pivot(x,prec,&d,&r);

  /* r = dim ker(x) */
  if (!r) { avma=av; if (d) free(d); return gcopy(x); }

  /* r = dim Im(x) */
  r = lg(x)-1 - r; avma=av;
  y=cgetg(r+1,t_MAT);
  for (j=k=1; j<=r; j++,k++)
  {
    while (!d[k]) k++;
    y[j]=lcopy((GEN) x[k]);
  }
  free(d); return y;
}

GEN
image(GEN x) /* Programme pour types exacts */
{
  return image0(x,0);
}

GEN
imagereel(GEN x, long prec) /* Programme pour types inexacts */
{
  return image0(x,prec);
}

static GEN
imagecompl0(GEN x, long prec)
{
  GEN d,y;
  long j,k,r,av = avma;

  gauss_pivot(x,prec,&d,&r);
  avma=av; y=cgetg(r+1,t_VEC);
  for (j=k=1; j<=r; j++,k++)
  {
    while (d[k]) k++;
    y[j]=lstoi(k);
  }
  if (d) free(d); return y;
}

/* for hnfspec. return an array of long */
static GEN
imagecomplspec(GEN x, long *nlze)
{
  GEN d,y;
  long j,k,r,av = avma;

  gauss_pivot(x,0,&d,&r);
  avma=av; y=cgeti(r+1);
  for (j=k=1; j<=r; j++,k++)
  {
    while (d[k]) k++;
    y[j]=k;
  }
  *nlze=j-1; if (d) free(d);
  return y;
}

GEN
imagecompl(GEN x) /* Programme pour types exacts */
{
  return imagecompl0(x,0);
}

static GEN
sinverseimage(GEN mat, GEN y)
{
  long av=avma,tetpil,i, nbcol = lg(mat);
  GEN p1,col;

  if (typ(mat)!=t_MAT || typ(y)!=t_COL) err(typeer,"sinverseimage");
  p1=cgetg(nbcol+1,t_MAT); p1[nbcol] = (long)y;
  for (i=1; i<nbcol; i++) p1[i]=mat[i];

  p1 = ker(p1); i=lg(p1)-1;
  if (!i) { avma=av; return cgetg(1,t_COL); }

  col = (GEN)p1[i]; p1 = (GEN) col[nbcol];
  if (gcmp0(p1)) { avma=av; return cgetg(1,t_COL); }

  p1 = gneg(p1); setlg(col,nbcol); tetpil=avma;
  return gerepile(av,tetpil, gdiv(col, p1));
}

/* Calcule l'image reciproque de v par m */
GEN
inverseimage(GEN m,GEN v)
{
  long j,lv,tv=typ(v);
  GEN mat;

  if (tv==t_COL) return sinverseimage(m,v);
  if (tv!=t_MAT) err(typeer,"inverseimage");
  lv=lg(v)-1; mat=cgetg(lv+1,t_MAT);
  for (j=1; j<=lv; j++)
    mat[j] = (long) sinverseimage(m,(GEN)v[j]);
  return mat;
}

/* x is an n x k matrix, rank(x) = k <= n. Return an invertible n x n matrix
 * whose first k columns are given by x. If rank(x)<k, the result may be wrong
 */
GEN
suppl_intern(GEN x, GEN myid)
{
  long av = avma, lx = lg(x), n,i,j;
  GEN y,p1;
  stackzone *zone;

  if (typ(x) != t_MAT) err(typeer,"suppl");
  if (lx==1) err(talker,"empty matrix in suppl");
  n=lg(x[1]); if (lx>n) err(suppler2);

  zone  = switch_stack(NULL, n*n);
  switch_stack(zone,1);
  y = myid? dummycopy(myid): idmat(n-1);
  switch_stack(zone,0);
  for (i=1; i<lx; i++)
  {
    p1=gauss(y,(GEN)x[i]); j=i;
    while (j<n && gcmp0((GEN)p1[j])) j++;
    if (j>=n) err(suppler2);
    p1=(GEN)y[i]; y[i]=x[i]; if (i!=j) y[j]=(long)p1;
  }
  avma = av; y = gcopy(y);
  free(zone); return y;
}

GEN
suppl(GEN x)
{
  return suppl_intern(x,NULL);
}

GEN
image2(GEN x)
{
  long av=avma,tetpil,k,n,i;
  GEN p1,p2;

  if (typ(x)!=t_MAT) err(typeer,"image2");
  k=lg(x)-1; if (!k) return gcopy(x);
  n=lg(x[1])-1; p1=ker(x); k=lg(p1)-1;
  if (k) { p1=suppl(p1); n=lg(p1)-1; }
  else p1=idmat(n);
  
  tetpil=avma; p2=cgetg(n-k+1,t_MAT);
  for (i=k+1; i<=n; i++) p2[i-k]=lmul(x,(GEN) p1[i]);
  return gerepile(av,tetpil,p2);
}

GEN
matimage0(GEN x,long flag)
{
  switch(flag)
  {
    case 0: return image(x);
    case 1: return image2(x);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

long
rank(GEN x)
{
  long av = avma, r;
  GEN d;

  gauss_pivot(x,0,&d,&r);
  /* yield r = dim ker(x) */

  avma=av; if (d) free(d);
  return lg(x)-1 - r;
}

static
int compare_long(long *a,long *b)
{
  return *a-*b;
}

GEN
indexrank(GEN x)
{
  long av = avma, i,j,n,r;
  GEN res,d,p1,p2;

  /* yield r = dim ker(x) */
  gauss_pivot(x,0,&d,&r);

  /* now r = dim Im(x) */
  n = lg(x)-1; r = n - r;
  
  avma=av; res=cgetg(3,t_VEC);
  p1=cgetg(r+1,t_VEC); res[1]=(long)p1;
  p2=cgetg(r+1,t_VEC); res[2]=(long)p2;
  if (d)
  {
    for (i=0,j=1; j<=n; j++)
      if (d[j]) { i++; p1[i]=d[j]; p2[i]=j; }
    free(d);
    qsort(p1+1,r,sizeof(long),(int(*)(ANYARG))compare_long);
  } 
  for (i=1;i<=r;i++) { p1[i]=lstoi(p1[i]); p2[i]=lstoi(p2[i]); }
  return res;
}

/*******************************************************************/
/*                                                                 */
/*                        EIGENVECTORS                             */
/*   (independent eigenvectors, sorted by increasing eigenvalue)   */
/*                                                                 */
/*******************************************************************/

GEN
eigen(GEN x, long prec)
{
  GEN y,z,rr,p,ssesp,eps,r1,r2,r3;
  long j,k,n,ly,av,tetpil,nbrac;

  if (typ(x)!=t_MAT) err(typeer,"eigen");
  n=lg(x); if (n != lg(x[1])) err(mattype1,"eigen");
  if (n<=2) return gcopy(x);

  av=avma; eps=cgetr(3); eps[2]=HIGHBIT;
  eps[1]=evalsigne(1)+HIGHEXPOBIT+16-bit_accuracy(prec);
  y=cgetg(n,t_MAT); z=dummycopy(x);
  p=caradj(x,0,0); rr=roots(p,prec); nbrac=lg(rr)-1;
  /* ce n'est pas comme cela qu'on doit calculer les valeurs propres !*/

  ly=n; k=1; r2=(GEN)rr[1];
  for(;;)
  {
    r3=ground(r2);
    if (gcmp(gabs(gsub(r2,r3),MEDDEFAULTPREC),eps)<0) r2=r3;
    for (j=1; j<n; j++)
      coeff(z,j,j)=lsub(gcoeff(x,j,j),r2);
    ssesp=ker0(z,prec,gzero,gun); j=lg(ssesp);
    while (j>1) y[--ly]=ssesp[--j]; /* we are done with this eigenspace */

    r1=r2; /* try to find a different eigenvalue */
    do
    {
      if (k==nbrac) { tetpil=avma; return gerepile(av,tetpil,gcopy(y)); }
      k++; r2=(GEN)rr[k];
    }
    while (gcmp(gabs(gsub(r1,r2),MEDDEFAULTPREC),eps) < 0);
  }
}

/*******************************************************************/
/*                                                                 */
/*                           DETERMINANT                           */
/*                                                                 */
/*******************************************************************/

GEN
det0(GEN a,long flag)
{
  switch(flag)
  {
    case 0: return det(a);
    case 1: return det2(a);
    default: err(flagerr);
  }
  return NULL; /* not reached */
}

/* Exact types: choose the first non-zero pivot. Otherwise: maximal pivot */
static GEN
det_simple_gauss(GEN a, long inexact)
{
  long nbco,i,j,k,av,av1,s,exchange;
  GEN x,p,m;

  if (typ(a)!=t_MAT) err(mattype1,"det2");
  nbco=lg(a)-1; if (!nbco) return gun;
  if (nbco != lg(a[1])-1) err(mattype1,"det2");

  av=avma; s=1; x=gun; a=dummycopy(a);
  for (i=1; i<nbco; i++)
  {
    p=gcoeff(a,i,i); k=i;
    if (inexact)
    {
      GEN p1,p2;

      av1 = avma;
      p2 = gabs(p,DEFAULTPREC);
      for (j=i+1; j<=nbco; j++)
      {
        p1 = gabs(gcoeff(a,i,j),DEFAULTPREC);
        if (gcmp(p1,p2)>0) { p2=p1; k=j; }
      }
      if (gcmp0(p2)) { av1=avma; return gerepile(av,av1,gcopy(p2)); }
      exchange = (k > i); avma=av1;
    }
    else
    {
      exchange = gcmp0(p);
      if (exchange)
      {
        do k++; while(k<=nbco && gcmp0(gcoeff(a,i,k)));
        if (k>nbco) { avma=av; return gzero; }
      }
    }
    if (exchange)
    {
      j=a[k]; a[k]=a[i]; a[i]=j;
      s = -s; p = gcoeff(a,i,i); 
    }

    x=gmul(x,p);
    for (k=i+1; k<=nbco; k++)
    {
      m=gcoeff(a,i,k);
      if (!gcmp0(m))
      {
	m=gdiv(m,p);
	for (j=i+1; j<=nbco; j++)
	  coeff(a,j,k)=lsub(gcoeff(a,j,k),gmul(m,gcoeff(a,j,i)));
      }
    }
  }
  if (s<0) x=gneg(x);
  av1=avma; return gerepile(av,av1,gmul(x,gcoeff(a,nbco,nbco)));
}

GEN
det2(GEN x)
{
  return det_simple_gauss(x,isinexactreal(x));
}

/* determinant in a ring A: all computations are done within A
 * (Gauss-Bareiss algorithm)
 */
GEN
det(GEN a)
{
  long nbco,i,j,k,av,av1,s;
  GEN p1,p,m,pprec;

  if (isinexactreal(a)) return det_simple_gauss(a,1);
  if (typ(a)!=t_MAT) err(mattype1,"det");
  nbco=lg(a)-1; if (!nbco) return gun;
  if (nbco != lg(a[1])-1) err(mattype1,"det");

  av=avma; a=dummycopy(a);
  pprec=gun; s=1;
  for (i=1; i<nbco; i++)
  {
    p=gcoeff(a,i,i); k=i;
    if (gcmp0(p))
    {
      k=i+1; while (k<=nbco && gcmp0(gcoeff(a,i,k))) k++;
      if (k>nbco) { avma=av; return gzero; }

      p=gcoeff(a,i,k);
      j=a[k]; a[k]=a[i]; a[i]=j;
      s = -s;
    }
    for (k=i+1; k<=nbco; k++)
    {
      m=gcoeff(a,i,k);
      for (j=i+1; j<=nbco; j++)
      {
	p1=gsub(gmul(p,gcoeff(a,j,k)),gmul(m,gcoeff(a,j,i)));
	if (typ(p1)==t_POL && typ(pprec)==t_POL && varn(p1)==varn(pprec))
	  coeff(a,j,k)=ldeuc(p1,pprec);
	else
          coeff(a,j,k)=ldiv(p1,pprec);
      }
    }
    pprec=p;
  }
  av1=avma; p = gcoeff(a,nbco,nbco);
  p = (s>0)? gcopy(p): gneg(p);
  return gerepile(av,av1,p);
}

/*******************************************************************/
/*                                                                 */
/*                      HNF   SPECIAL                              */
/*                                                                 */
/*******************************************************************/

/* On se donne une matrice mxn mat de long, une matrice matc rxn de GEN (sous
 * forme de pointeur ptmatc), un vecteur vec et un entier k0<=m.  On suppose
 * que les k0 premieres lignes de mat sont (peut-etre) denses, mais que les
 * suivantes sont creuses. On ressort avec une matrice matgen contenant la
 * partie non-archimedienne gauche, matalpha contenant la partie droite, matc
 * est modifiee, vec est permute. La permutation est contenue dans v, et
 * v[i]=i pour i<=k0.
 *
 * A usage interne. Pas de verifications
 */

static int
compte(long **mat, long row, long len, long *firstnonzero)
{
  int j, n=0;

  for (j=1; j<=len; j++)
  {
    const long p = mat[j][row];
    if (p)
    {
      if (labs(p)!=1) return -1;
      n++; *firstnonzero=j;
    }
  }
  return n;
}

static int
compte2(long **mat, long row, long len, long *firstone)
{
  int j, n=0;

  *firstone=0;
  for (j=1; j<=len; j++)
  {
    const long p = mat[j][row];
    if (p) { n++; if (labs(p)==1) *firstone=j; }
  }
  return n;
}

static GEN
hnffinal(GEN matgen, GEN* ptpdep, GEN* ptmatc,long* vperm,GEN* ptmatalpha,long lnz,long co,long li,long col,long lig,long nlze,long* ptcol)
{
  GEN p1,p2,p3,p4,wpro,wpronew,matalphanew,matcnew;
  GEN matalpha=*ptmatalpha,matc=*ptmatc,pdep=*ptpdep,pdepnew;
  long av,i,j,k,s,i1,j1,j2,lim;
  int fl;

  if (DEBUGLEVEL>5)
  {
    fprintferr("Entree dans hnffinal:\n");
    fprintferr("***** AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6)
    {
      fprintferr("mit =\n"); outerr(matgen);
      if (nlze) { fprintferr("pdep =\n"); outerr(pdep); }
      fprintferr("matalpha =\n"); outerr(matalpha);
    }
  }

/*
  VERSION LLLKERIM

  u1u2=lllkerim(matgen); u1=(GEN)u1u2[1]; u2=(GEN)u1u2[2];
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres lllkerim dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  if (lg(u2)<=lnz) 
    err(talker,"matrix not of maximal rank in hermite spec");
  p1=gmul(matgen,u2);
  detmat=absi(det(p1));
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres det dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  wpro=hnfmod(p1,detmat);
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres hnfmod dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  p2=gmul(u1,lllint(u1));
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres lllint dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  p3=gmul(u2,gauss(p1,wpro));
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres gauss dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  p4=cgetg(col+1,t_MAT);
  for (j=1; j<lg(p2); j++) p4[j]=p2[j];
  for (j=lg(p2); j<=col; j++) p4[j]=p3[j+1-lg(p2)];

  */

/*
  VERSION HNFHAVAS

  p2=hnfhavas(matgen); p1=(GEN)p2[1]; p4=(GEN)p2[2]; p5=(GEN)p2[3];
  if (DEBUGLEVEL>6)
  {
  fprintferr("apres hnfhavas dans hnffinal:\n");
  fprintferr("***** AVMA = %ld\n",avma);
  }
  for (i=1; i < lg(p1) && gcmp0(p1[i]); i++);
  i1=i-1;
  u1=cgetg(i,t_MAT); for (j=1; j<i; j++) u1[j]=p4[j];
  wpro=cgetg(j1=lg(p1)-i1,t_MAT); for (j=1; j<j1; j++) wpro[j]=p1[i1+j];
  p2=cgetg(lg(p5),t_VEC);
  for (i=1; i<lg(p5); i++) p2[i]=lstoi(vperm[nlze+itos(p5[i])]);
  for (i=1; i<lg(p5); i++) vperm[nlze+i]=itos(p2[i]);
  p2=u1;
  p1=cgetg(j1,t_MAT); for (j=1; j<j1; j++) p1[j]=p4[i1+j];
  matalphanew=cgetg(co-col+1,t_MAT);
  for (j=1; j<=co-col; j++)
  {
  p3=cgetg(lig+1,t_COL); matalphanew[j]=(long)p3;
  for (i=1; i<=nlze; i++) p3[i]=coeff(matalpha,i,j);
  for (; i<=lig; i++) p3[i]=coeff(matalpha,nlze+itos(p5[i-nlze]),j);
  }
  matalpha=matalphanew;
  */

/* VERSION HNFBATUT */

  p2=hnfall(matgen); wpro=(GEN)p2[1]; p4=(GEN)p2[2];
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres hnfbatut dans hnffinal:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
  }
  j1=lg(wpro); i=col-j1+2; i1=i-1;
  p2=cgetg(i,t_MAT); for (j=1; j<i; j++) p2[j]=p4[j];
  p1=cgetg(j1,t_MAT); for (j=1; j<j1; j++) p1[j]=p4[i1+j];

  p3=cgetg(col+1,t_MAT); for (j=1; j<=col; j++) p3[j]=matc[j];
  p3=gmul(p3,p4); if (nlze) pdep=gmul(pdep,p4);
  matcnew=cgetg(co+1,t_MAT);
  for (j=1; j<=col; j++) matcnew[j]=p3[j];
  for (   ; j<=co ; j++) matcnew[j]=matc[j];
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres initialisation de hnffinal:\n");
    fprintferr("    ***** AVMA = %ld\n",avma); flusherr();
  }
  av=avma; lim=(bot+av)>>1;
  for (s=0,i=lnz; i>0; i--)
  {
    p1=gcoeff(wpro,i,i); if ((fl=gcmp1(p1))) s++;
    for (j=col+1; j<=co; j++)
    {
      p2=fl ? gcoeff(matalpha,i+nlze,j-col)
            : gdivent(gcoeff(matalpha,i+nlze,j-col),p1);
      for (k=1; k<=nlze; k++)
	coeff(matalpha,k,j-col)=lsub(gcoeff(matalpha,k,j-col),
	                             gmul(p2,gcoeff(pdep,k,i+col-lnz)));
      for (   ; k<=lig; k++)
	coeff(matalpha,k,j-col)=lsub(gcoeff(matalpha,k,j-col),
	                             gmul(p2,gcoeff(wpro,k-nlze,i)));
      matcnew[j]=lsub((GEN) matcnew[j],gmul(p2,(GEN) matcnew[i+col-lnz]));
    }
    if (low_stack(lim, (bot+av)>>1))
    {
      GEN *gptr[2];
      if(DEBUGMEM>1) err(warnmem,"hnffinal");
      gptr[0]=&matcnew; gptr[1]=&matalpha;
      gerepilemany(av,gptr,2);
    }
  }
  p1=cgetg(li+1,t_VEC);
  for (i=1,i1=0,j1=0; i<=lnz; i++)
  {
    if (gcmp1(gcoeff(wpro,i,i)))
      p1[(++j1)+lig-s] = vperm[i+nlze];
    else
      p1[(++i1)+nlze] = vperm[i+nlze];
  }
  for (i=nlze+1; i<=lig; i++) vperm[i]=p1[i];
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres premiere passe de hnffinal:\n");
    fprintferr("    ***** AVMA = %ld\n",avma); flusherr();
  }
  wpronew=cgetg(lnz-s+1,t_MAT); matalphanew=cgetg(co-col+s+1,t_MAT);
  matc=cgetg(co+1,t_MAT); if (nlze) pdepnew=cgetg(lnz-s+1,t_MAT);
  for (j1=1; j1<=col-lnz; j1++) matc[j1]=matcnew[j1];
  for (j=1,j1=j2=0; j<=lnz; j++)
  {
    if (!gcmp1(gcoeff(wpro,j,j)))
    {
      p1=cgetg(lnz-s+1,t_COL); wpronew[++j1]=(long)p1;
      matc[j1+col-lnz]=matcnew[j+col-lnz];
      if (nlze) pdepnew[j1]=pdep[j+col-lnz];
    }
    else
    {
      p1=cgetg(lig-s+1,t_COL); matalphanew[++j2]=(long)p1;
      matc[j2+col-s]=matcnew[j+col-lnz];
      for (i=1; i<=nlze; i++) p1[i]=coeff(pdep,i,j+col-lnz);
      p1 += nlze;
    }
    for (i=1,i1=0; i<=lnz; i++)
      if (!gcmp1(gcoeff(wpro,i,i))) p1[++i1]=coeff(wpro,i,j);
  }
  for (j=col+1; j<=co; j++)
  {
    p1=cgetg(lig-s+1,t_COL); matalphanew[j-col+s]=(long)p1;
    for (i=1; i<=nlze; i++) p1[i]=coeff(matalpha,i,j-col);
    matc[j]=matcnew[j];
  }
  for (i=1,i1=0; i<=lnz; i++)
    if (!gcmp1(gcoeff(wpro,i,i)))
    {
      i1++;
      for (j=col+1; j<=co; j++)
	coeff(matalphanew,i1+nlze,j-col+s)=coeff(matalpha,i+nlze,j-col);
    }
  *ptmatc=matc; *ptmatalpha=matalphanew; if (nlze) *ptpdep=pdepnew;
  if (DEBUGLEVEL>5)
  {
    fprintferr("Sortie de hnffinal:\n");
    fprintferr("***** AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6)
    {
      fprintferr("mit =\n"); outerr(wpronew);
      if (nlze) { fprintferr("pdep =\n"); outerr(pdepnew); }
      fprintferr("matalpha =\n"); outerr(matalphanew);
    }
  }
  *ptcol=col-s; return wpronew;
}

/* for debugging */
static void
p_mat(long **mat, long *vperm, long li, long co)
{ 
  long av=avma, i,j;
  GEN p1, matgen=cgetg(co+1,t_MAT);
  for (j=1; j<=co; j++)
  {
    p1=cgetg(li+1,t_COL); matgen[j]=(long)p1;
    for (i=1; i<=li; i++) p1[i]=lstoi(mat[j][vperm[i]]);
  }
  fprintferr("matgen =\n"); outerr(matgen); avma=av;
}

static void
p_perm(long *vperm, long li)
{
  long i;
  fprintferr("Permutation:\n");
  for (i=1; i<=li; i++) fprintferr("vperm[%ld] = %ld\n",i,vperm[i]);
  flusherr();
}

GEN
hnfspec(long** mat, GEN* ptpdep, GEN* ptmatc,long* vperm,GEN* ptmatalpha,
        long co,long li,long k0,long* ptnlze,long* ptcol)
{
  long av=avma,av2,tetpil,*p,i,i0,i1,j,k,fl,lk0,col,lig,*ww;
  long nb,n,s,s1,t,limt,lim,nlze,lnz,colnew,lp3;
  GEN p1,p2,p3,p4,matgen,vmax,matu,matc,matid;
  GEN matalpha,wpronew,pdep,permpro;
  GEN *gptr[4];

  if (DEBUGLEVEL>5)
  {
    fprintferr("Entree dans hnfspec:\n");
    fprintferr("***** AVMA = %ld\n",avma);
    p_perm(vperm,li); if (DEBUGLEVEL>6) p_mat(mat,vperm,li,co);
  }
  matu=cgetg(co+1,t_MAT);
  for (j=1; j<=co; j++)
  {
    p1=cgetg(k0+1,t_COL); matu[j]=(long)p1;
    for (i=1; i<=k0; i++) p1[i]=lstoi(mat[j][vperm[i]]);
  }
  vmax=cgeti(co+1); av2=avma; lim=(av2+bot)>>1;

  i=lig=li; col=co; lk0=k0; matid=idmat(co);
  while (i>lk0)
  {
    switch( compte(mat,vperm[i],col,&n) )
    {
      case 0: lk0++;
	if (i>lk0) { s=vperm[i]; vperm[i]=vperm[lk0]; vperm[lk0]=s; }
	i=lig; break;

      case 1:
	p=mat[n]; mat[n]=mat[col]; mat[col]=p;
	p1=(GEN)matid[n]; matid[n]=matid[col]; matid[col]=(long)p1;
	if (p[vperm[i]]<0)
	{
	  for (k=k0+1; k<=li; k++) p[vperm[k]]= -p[vperm[k]];

	  /* matid[col] = gneg(matid[col]); */
	  k=1; while (gcmp0((GEN)p1[k])) k++;
	  p1[k] = lnegi((GEN)p1[k]);
	}
	if (i<lig) { s=vperm[i]; vperm[i]=vperm[lig]; vperm[lig]=s; }
	lig--; col--; i=lig; break;

      default:
	i--;
    }
  }
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres phase1:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
    p_perm(vperm,li);
    if (DEBUGLEVEL>6) p_mat(mat,vperm,li,co);
  }

#if 0
{
  long sizemax=0;
  while (lig>lk0 && sizemax<=(HIGHBITM1>>1))
  {
    i=lig;
    while (i>lk0 && (nb=compte(mat,vperm[i],col,&n)) < 0) i--;
    if (nb==0)
    {
      lk0++;
      if (i>lk0) { s=vperm[i]; vperm[i]=vperm[lk0]; vperm[lk0]=s; }
    }
    else
    {
      if (nb < 0) break;
      p=mat[n]; mat[n]=mat[col]; mat[col]=p;
      p1=(GEN)matid[n]; matid[n]=matid[col]; matid[col]=(long)p1;
      if (p[vperm[i]]<0)
      {
	for (k=k0+1; k<=li; k++) p[vperm[k]] = -p[vperm[k]];
	p1 = gneg(p1); matid[col] = (long)p1;
      }
      if (i<lig) { s=vperm[i]; vperm[i]=vperm[lig]; vperm[lig]=s; }
      if (nb>1)
	for (j=1; j<n; j++)
	{
	  t=mat[j][vperm[lig]];
	  if (t==1)
	  {
	    for (i=k0+1; i<=li; i++)
	    {
	      mat[j][vperm[i]] -= p[vperm[i]];
	      sizemax = max(sizemax,labs(mat[j][vperm[i]]));
	    }
	    matid[j] = lsub((GEN) matid[j],p1);
	  }
	  else if (t)
	  {
	    for (i=k0+1; i<=li; i++)
	    {
	      mat[j][vperm[i]] += p[vperm[i]];
	      sizemax = max(sizemax,labs(mat[j][vperm[i]]));
	    }
	    matid[j] = ladd((GEN) matid[j],p1);
	  }
	}
      lig--; col--;
    }
    if (low_stack(lim, (bot+av2)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"[1]: hnfspec");
      tetpil=avma; matid=gerepile(av2,tetpil,gcopy(matid));
    }
  }
}
#endif
  for (j=1; j<=co; j++)
  {
    s=0; for (i=k0+1; i<=li; i++) s=max(s,labs(mat[j][i]));
    vmax[j]=s;
  }

  fl=1;
  while (lig>lk0 && fl)
  {
    for (i=lig; i>lk0; i--)
    {
      nb=compte2(mat,vperm[i],col,&n);
      if (n || !nb) break;
    }
    if (!nb)
    {
      lk0++;
      if (i>lk0) { s=vperm[i]; vperm[i]=vperm[lk0]; vperm[lk0]=s; }
    }
    else
    {
      if (!n) break;
      p=mat[n]; mat[n]=mat[col]; mat[col]=p;
      s=vmax[n]; vmax[n]=vmax[col]; vmax[col]=s;
      p1=(GEN)matid[n]; matid[n]=matid[col]; matid[col]=(long)p1;
      if (p[vperm[i]]<0)
      {
	for (k=k0+1; k<=li; k++) p[vperm[k]] = -p[vperm[k]];
	p1 = gneg(p1); matid[col] = (long)p1;
      }
      if (i<lig) { s=vperm[i]; vperm[i]=vperm[lig]; vperm[lig]=s; }
      for (j=1; j<col; j++)
      {
	if (vmax[col]) limt=(HIGHBITM1-vmax[j])/vmax[col];
	t=mat[j][vperm[lig]];
	if (t)
	{
	  if (!vmax[col] || labs(t)<=limt)
	  {
	    s=0;
	    for (i=k0+1; i<=li; i++)
	    {
	      s1 = mat[j][vperm[i]] -= t*p[vperm[i]];
	      s=max(s,labs(s1));
	    }
	    vmax[j]=s;
	    matid[j]=lsub((GEN) matid[j],gmulsg(t,p1));
	  }
	  else fl=0;
	 }
      }
      if (fl) { lig--; col--; }
    }
    if (low_stack(lim, (bot+av2)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"[2]: hnfspec");
      tetpil=avma; matid=gerepile(av2,tetpil,gcopy(matid));
    }
  }

  matgen=cgetg(co+1,t_MAT);
  for (j=1; j<=co; j++)
  {
    p1=cgetg(li-k0+1,t_COL); matgen[j]=(long)p1;
    for (i=k0+1; i<=li; i++) p1[i-k0]=lstoi(mat[j][vperm[i]]);
  }
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres phase2:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
    p_perm(vperm,li);
    if (DEBUGLEVEL>6) outerr(matgen);
  }
  for (i=li-1; i>lig; i--)
  {
    p2=(GEN)matgen[i+co-li];
    for (j=i+co-li+1; j<=co; j++)
    {
      p1=(GEN)matgen[j]; p3=(GEN)p1[i-k0]; s=signe(p3);
      if (s)
      {
	i0=i-k0; p1[i0]=zero;
	if (!is_pm1(p3))
	{
	  for (i1=1; i1<i0; i1++)
	    p1[i1]=lsubii((GEN) p1[i1],mulii(p3,(GEN) p2[i1]));
	  matid[j]=lsub((GEN) matid[j],gmul(p3,(GEN) matid[i+co-li]));
	}
	else
	{
	  if (s>0) /* p3 = 1 */
	  {
	    for (i1=1; i1<i0; i1++)
	      p1[i1]=lsubii((GEN) p1[i1],(GEN) p2[i1]);
	    matid[j]=lsub((GEN) matid[j],(GEN) matid[i+co-li]);
	  }
	  else  /* p3 = -1 */
	  {
	    for (i1=1; i1<i0; i1++)
	      p1[i1]=laddii((GEN) p1[i1],(GEN) p2[i1]);
	    matid[j]=ladd((GEN) matid[j],(GEN) matid[i+co-li]);
	  }
	}
      }
    }
    if (low_stack(lim, (bot+av2)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"[3]: hnfspec");
      gptr[0]=&matid; gptr[1]=&matgen;
      gerepilemany(av2,gptr,2);
    }
  }
  gptr[0]=&matid; gptr[1]=&matgen; gerepilemany(av2,gptr,2);

  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres nettoyage identite:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6) outerr(matgen);
  }
  nlze=lk0-k0; lnz=lig-nlze; p1=cgeti(li+1);
  for (i=1; i<=nlze; i++) p1[i]=vperm[i+k0];
  for (i=1; i<=k0; i++) p1[i+nlze]=vperm[i];
  for (i=1; i<=lk0; i++) vperm[i]=p1[i];

  matu=gmul(matu,matid); matc=gmul(*ptmatc,matid);
  p1=cgetg(col+1,t_MAT);
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres 1ere phase calculs finaux:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
  }
  for (j=1; j<=col; j++)
  {
    p2=cgetg(lnz+1,t_COL); p1[j]=(long)p2;
    for (i=1; i<=k0; i++) p2[i]=coeff(matu,i,j);
    for (   ; i<=lnz; i++) p2[i]=coeff(matgen,i+nlze-k0,j);
  }

  p3=imagecomplspec(gtrans(p1),&lp3);
  permpro=cgeti(lnz+1); ww=cgeti(lnz+1);
  for (i=1; i<=lnz; i++) ww[i]=1;
  for (i=1; i<=lp3; i++)
    { permpro[i]=p3[i]; ww[permpro[i]]=0; }
  for (j=1; j<=lnz; j++)
    if (ww[j]) { permpro[i]=j; i++; }
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres 2eme phase calculs finaux:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
  }

  p4=cgetg(col+1,t_MAT);
  for (j=1; j<=col; j++)
  {
    p2=cgetg(lnz+1-lp3,t_COL); p4[j]=(long)p2;
    for (i=lp3+1; i<=lnz; i++) p2[i-lp3]=coeff(p1,permpro[i],j);
  }

  pdep=cgetg(col+1,t_MAT);
  for (j=1; j<=col; j++)
  {
    p2=cgetg(nlze+lp3+1,t_COL); pdep[j]=(long)p2;
    for (i=1; i<=nlze; i++) p2[i]=zero;
    for (   ; i<=nlze+lp3; i++) p2[i]=coeff(p1,permpro[i-nlze],j);
  }

  matalpha=cgetg(co-col+1,t_MAT);
  for (j=col+1; j<=co; j++)
  {
    p2=cgetg(lig+1,t_COL); matalpha[j-col]=(long)p2;
    for (i=1; i<=nlze; i++) p2[i]=coeff(matgen,i,j);
    for (i=1; i<=lnz; i++)
    {
      k=permpro[i];
      p2[i+nlze]=(k<=k0)?coeff(matu,k,j):coeff(matgen,k-k0+nlze,j);
    }
  }
  if (DEBUGLEVEL>5)
  {
    fprintferr("    apres calculs finaux:\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
  }
  av2=avma; p1=cgeti(li+1);
  for (i=nlze+1; i<=lig; i++) p1[i] = vperm[permpro[i-nlze]+nlze];
  for (i=nlze+1; i<=lig; i++) vperm[i] = p1[i];

  wpronew = hnffinal(p4,&pdep,&matc,vperm,&matalpha,lnz-lp3,co,li,col,lig,
                     nlze+lp3,&colnew);

  *ptmatc=matc; *ptmatalpha=matalpha; *ptpdep=pdep; *ptcol=colnew;
  gptr[0]=ptmatc; gptr[1]=ptmatalpha; gptr[2]=ptpdep; gptr[3]=&wpronew;
  *ptnlze=nlze+lp3; gerepilemany(av,gptr,4);
  if (DEBUGLEVEL)
  { 
    if (DEBUGLEVEL>7)
    { 
      fprintferr("$$$$$ AVMA = %ld\n",avma);
      fprintferr("matc: "); outerr(matc);
    } 
    msgtimer("hnfspec");
  }
  return wpronew;
}

GEN
hnfadd(GEN mit, GEN* ptpdep, GEN* ptmatc,long* vperm,GEN* ptmatalpha,long co,
       long li,long col,long* ptnlze,GEN extramat,GEN extramatc)
{
  GEN p1,p2,p3,p4,extramatnew,matcnew,permpro;
  GEN matalpha=*ptmatalpha, matc=*ptmatc, pdep=*ptpdep, *gptr[4];
  long av = avma, i,j,extrarel,lmit,lig,colshort,nlze=*ptnlze, *ww;

  if (DEBUGLEVEL>5)
  {
    fprintferr("Entree dans hnfadd :\n");
    fprintferr("***** AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6) { fprintferr("extramat =\n"); outerr(extramat); }
  }
  lmit=lg(mit)-1; lig=lmit+nlze;
  extrarel=lg(extramat)-1; 
  extramatnew=cgetg(extrarel+1,t_MAT);
  p3=cgetg(extrarel+1,t_MAT);
  for (j=1; j<=extrarel; j++)
  {
    p1=cgetg(lig+1,t_COL); extramatnew[j] = (long)p1;
    p2 = (GEN)extramat[j];
    for (i=1; i<=lig; i++) p1[i]=p2[i];
    p1=cgetg(li-lig+1,t_COL); p3[j]=(long)p1;
    for (   ; i<=li; i++) p1[i-lig]=p2[i];
  }
  if (li != lig)
  {
    GEN matalphac=cgetg(co-col+1,t_MAT);
    for (j=col+1; j<=co; j++) matalphac[j-col]=matc[j];

    extramatnew = gsub(extramatnew,gmul(matalpha,p3));
    extramatc   = gsub(extramatc,gmul(matalphac,p3));
  }

  colshort=extrarel+lmit;
  extramat=cgetg(colshort+1,t_MAT);
  matcnew=cgetg(co-col+colshort+1,t_MAT);
  for (j=1; j<=extrarel; j++)
  {
    extramat[j]=extramatnew[j];
    matcnew[j]=extramatc[j];
  }
  for (   ; j<=colshort; j++)
  {
    p1=cgetg(lig+1,t_COL); extramat[j]=(long)p1;
    p2 = (GEN)pdep[j-extrarel]; for (i=1; i<=nlze; i++) p1[i]=p2[i];
    p2 = (GEN) mit[j-extrarel]; for (   ; i<=lig ; i++) p1[i]=p2[i-nlze];
  }
  if (DEBUGLEVEL>5)
  {
    fprintferr("    1ere phase de hnfadd :\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6)
      { fprintferr("extramat =\n"); outerr(extramat); }
  }
  for (j=extrarel+1; j<=co-col+colshort; j++)
    matcnew[j]=matc[j-extrarel+col-lmit];

  p3=imagecomplspec(gtrans(extramat),&nlze);
  permpro=cgeti(lig+1); ww=cgeti(lig+1);
  for (i=1; i<=lig; i++) ww[i]=1;
  for (i=1; i<=nlze; i++)
    { permpro[i]=p3[i]; ww[permpro[i]]=0; }
  for (j=1; j<=lig; j++) 
    if (ww[j]) { permpro[i]=j; i++; }

  pdep=cgetg(colshort+1,t_MAT);
  p4=cgetg(colshort+1,t_MAT);
  for (j=1; j<=colshort; j++)
  {
    p2 = (GEN)extramat[j];
    p1=cgetg(nlze+1,t_COL); pdep[j]=(long)p1;
    p3=cgetg(lig+1-nlze,t_COL); p4[j]=(long)p3;
    for (i=1; i<=nlze; i++) p1[i]    = p2[permpro[i]];
    for (   ; i<=lig; i++) p3[i-nlze]= p2[permpro[i]];
  }
  p3=cgetg(li-lig+1,t_MAT);
  for (j=1; j<=li-lig; j++)
  {
    p2 = (GEN)matalpha[j]; 
    p1=cgetg(lig+1,t_COL); p3[j]=(long)p1;
    for (i=1; i<=lig; i++) p1[i]=p2[permpro[i]];
  }
  matalpha=p3; p1=cgeti(lig+1);
  for (i=1; i<=lig; i++) p1[i]=vperm[permpro[i]];
  for (i=1; i<=lig; i++) vperm[i]=p1[i];
  if (DEBUGLEVEL>5)
  {
    fprintferr("    2eme phase de hnfadd :\n");
    fprintferr("    ***** AVMA = %ld\n",avma);
  }
  mit=hnffinal(p4,&pdep,&matcnew,vperm,&matalpha,lig-nlze,co-col+colshort,
               li,colshort,lig,nlze,&j);
  p1=cgetg(co+extrarel+1,t_MAT);
  for (j=1; j <= col-lmit; j++) p1[j]=matc[j];
  for (   ; j <= co+extrarel; j++) p1[j]=matcnew[j-col+lmit];

  *ptmatc=p1; *ptmatalpha=matalpha; *ptpdep=pdep;
  gptr[0]=ptmatc; gptr[1]=ptmatalpha; gptr[2]=ptpdep; gptr[3]=&mit;
  *ptnlze=nlze; gerepilemany(av,gptr,4);

  if (DEBUGLEVEL)
  { 
    if (DEBUGLEVEL>7)
    {
      fprintferr("$$$$$ AVMA = %ld\n",avma);
      fprintferr("mit: "); outerr(mit);
      fprintferr("matc: "); outerr(matc);
    }
    msgtimer("hnfadd");
  }
  return mit;
}

/* return a solution of congruence system sum M_{ i,j } X_j = Y_i mod D_i
 * If ptu1 != NULL, put in *ptu1 a Z-basis of the homgeneous system
 */
static GEN
gaussmoduloall(GEN M, GEN D, GEN Y, GEN *ptu1)
{
  long n,i,j,nco,av=avma,tetpil;
  GEN p1,p2,p3,delta,mat,hmatu,hmat,u,u1,u2,x;

  if (typ(M)!=t_MAT || (typ(D)!=t_VEC && typ(D)!=t_COL) )
    err(typeer,"gaussmodulo");
  n=lg(D)-1; delta=diagonal(D); mat=concatsp(M,delta);
  hmatu=hnfall(mat); hmat=(GEN)hmatu[1]; u=(GEN)hmatu[2];
  nco=lg(M)-1; u2=cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    p1=cgetg(nco+1,t_COL); u2[j]=(long)p1; p2=(GEN)u[j+nco];
    for (i=1; i<=nco; i++) p1[i]=p2[i];
  }
  p3=gauss(hmat,Y); x=gmul(u2,p3);
  if (!gcmp1(denom(x))) { avma=av; return gzero; }
  u1=cgetg(nco+1,t_MAT);
  for (j=1; j<=nco; j++)
  {
    p1=cgetg(nco+1,t_COL); u1[j]=(long)p1; p2=(GEN)u[j];
    for (i=1; i<=nco; i++) p1[i]=p2[i];
  }
  tetpil=avma; x=lllreducemodmatrix(x,u1);
  if (!ptu1) x = gerepile(av,tetpil,x);
  else
  {
    GEN *gptr[2];
    *ptu1=gcopy(u1); gptr[0]=ptu1; gptr[1]=&x;
    gerepilemanysp(av,tetpil,gptr,2);
  }
  return x;
}

GEN
matsolvemod0(GEN M, GEN D, GEN Y, long flag)
{
  long av;
  GEN p1,y;

  if (flag) return gaussmoduloall(M,D,Y,NULL);

  av=avma; y = cgetg(3,t_VEC);
  p1 = gaussmoduloall(M,D,Y, (GEN*)y+2);
  if (p1==gzero) { avma=av; return gzero; }
  y[1] = (long)p1; return y;
}

GEN
gaussmodulo2(GEN M, GEN D, GEN Y)
{
  return matsolvemod0(M,D,Y,1);
}

GEN
gaussmodulo(GEN M, GEN D, GEN Y)
{
  return matsolvemod0(M,D,Y,0);
}
