/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*         CLASS GROUP AND REGULATOR (McCURLEY, BUCHMANN)          */
/*                    GENERAL NUMBER FIELDS                        */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/
/* $Id: buch2.c,v 2.0.0.2 1997/12/14 20:11:49 karim Exp karim $ */
#include "genpari.h"
#include "nf.h"

long addcolumntomatrix(long *V, long n,long r,GEN *INVP,long *L);
double check_bach(double cbach, double B);
GEN  compute_class_number(GEN mit,GEN *met,GEN *u1,GEN *u2);
GEN  fasthnf(GEN x,GEN detmat);
long ideal_is_zk(GEN ideal,long N);
GEN make_M(long n,long ru,long v, GEN basis, GEN roo);
GEN make_MC(long n,long r1,long ru,GEN M);
GEN get_roots(GEN x,long r1,long ru,long prec);
GEN idealpowred_prime(GEN nf, GEN vp, GEN n, long prec);
GEN get_arch(GEN nf,GEN x,long prec);

static const long CBUCHG = 15; /* de la forme 2^k-1 */
static const long randshift = BITS_IN_RANDOM-1 - 4; /* BITS_IN_RANDOM-1 - k */

static long KC,KC2,KCZ,KCZ2,lgsub,MAXRELSUP;
static long primfact[500],expoprimfact[500];
static long *factorbase, *numfactorbase, *numideal;
static GEN *idealbase, vectbase, subfactorbase, **powsubfactorbase;

/*   factorbase[i] contient le i-eme nombre premier utilise pour
 * construire la base de facteurs.
 *   numfactorbase[i] est l'indice k tel que factorbase[k]=i (si i
 * n'est pas premier, numfactorbase[i]=0).
 *
 *   subfactorbase est la sous-base de facteurs utilisee pour construire les
 * relations aleatoires.
 *   powsubfactorbase (matrice N x (CBUCHG+1) de GEN) contient les puissances.
 *   lgsub = lg(subfactorbase)
 *
 *   vectbase est un vecteur colonne contennant tous les ideaux de la
 * factorbase.
 *   idealbase[i] contient les ideaux premiers de norme convenable et au
 * dessus du nombre premier numero i.
 *   numideal[i] est l'indice k tel que idealbase[k]=i.
 *
 *   matcopy contient toutes les relations trouvees (non reduites, matrice
 * d'entiers courts).
 *   cmptglob = lg(matcopy), i.e le nombre de relations trouvees.
 *
 *   KCZ = le nombre de nombres premiers utilises pour construire la
 * base de facteurs jusqu'a la constante de Bach.
 *   KCZ2 = le nombre de nombres premiers de la base de facteurs
 * au total. 
 *
 *   KC  = le nombre d'ideaux premiers jusqu'a la constante de Bach.
 *   KC2  = le nombre d'ideaux premiers utilises au total. On n'utilise
 * que des premiers ne divisant pas l'index F, non inertes.
 */

static GEN buchall_for_degree_one_pol(GEN P,long flun);
static GEN class_group_generators(long PRECREG,long PRECREGINT,GEN nf,GEN met,GEN clh,GEN u1,GEN u2,long *vperm);
static GEN cleancol(GEN x,long N,long RU,long PRECREG);
static GEN compute_check(GEN sublambda,GEN z,long PRECREG,GEN *parch,GEN *reg);
static GEN compute_matt2(long RU,GEN nf);
static GEN compute_regulator(GEN xarch,long RU,long R1,long N,long sreg,long PRECREG,GEN *ptsublambda);
static GEN factorbasegen(GEN nf,long n2,long n);
static GEN getfu(GEN nf,GEN *ptxarch,GEN reg,long flun,long *pte,long PRECREG);
static GEN relationrank(long **mat,long n, long s,long *L);
static long be_honest(GEN nf,long RU,long PRECREGINT);
static long random_relation(long cmptglob, long lim,long LIMC,long N,long RU,long PRECREG,long PRECREGINT,GEN nf,long *vperm,long *subvperm,long **ma,GEN maarch,GEN lmatt2,long *ex,long phase);
static long small_norm_for_buchall(long s,long **mat,GEN matarch,long KCCO,long LIMC,long N,GEN D,long RU,long R1,long PRECREG,GEN nf,GEN gborne,long nbrelpid,GEN INVP,long *L);
static long subfactorbasegen(long N,long m,long minsfb,long *vperm);
static void powsubfactgen(GEN nf,long a,long PRECREG,long PRECREGINT);

/* x[0] = length(x) */
static long
ccontent(long* x)
{
  long i, s=labs(x[1]);
  for (i=2; i<=x[0] && s>1; i++) s=cgcd(labs(x[i]),s);
  return s;
}

static void
desallocate(long **matcopy, long cmptglob)
{
  long i;
  free(numfactorbase); free(factorbase); free(numideal); free(idealbase);
  if (powsubfactorbase)
  { 
    for (i=1; i<lg(subfactorbase); i++) free(powsubfactorbase[i]);
    free(powsubfactorbase);
  }
  if (matcopy)
  {
    for (i=1; i<=cmptglob; i++) free(matcopy[i]);
    free(matcopy);
  }
}

GEN
buchall(GEN P,GEN gcbach,GEN gcbach2,GEN gRELSUP,GEN gborne,long nbrelpid,
        long minsfb,long flun,long prec)
{
  long av = avma,av0,av1,tetpil,limpile,i,j,k,ss,n1,cmptglob;
  long N,R1,R2,RU,PRECREG,PRECREGINT,LIMC,LIMC2,lim,KCCO,KCCOPRO,RELSUP;
  long ip,extrarel,col,nlze,sreg,nrelsup,nreldep,phase,slim;
  long **mat,**matcopy,*vperm,*subvperm,*p1,*ex;
  double cbach,cbach2,drc,LOGD;
  GEN pgen1,lmatt2,matarch,fu,zu,nf,D,xarch,met,mit,reg,lfun,z,clh;
  GEN matalpha,u1,u2,RES,c_1,sublambda,pdep,parch,liste,invp,clgg,clg1,clg2;
  GEN CHANGE = NULL, extramat=NULL, extramatc=NULL;

  if (typ(P)==t_POL) nf = NULL;
  else
  {
    if (typ(P)!=t_VEC || lg(P)!=10) err(talker,"incorrect object in buchxxx");
    nf=P; P=(GEN)nf[1];
  }
  N=lgef(P)-3; if (N<=1) return buchall_for_degree_one_pol(P,flun);
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) { fprintferr("$$$$$ AVMA = %ld\n",avma); flusherr(); }
    timer2();
  }
  if (typ(gRELSUP)!=t_INT) gRELSUP=gtrunc(gRELSUP);
  RELSUP = itos(gRELSUP);
  if (RELSUP<=0) err(talker,"not enough relations in bnfxxx");

  /* Initializations */
  if (!nf)
  {
    nf=initalgall0(P,flun>=0? nf_REGULAR: nf_DIFFERENT,max(8,prec));
    if (lg(nf)==3) /* P was a non-monic polynomial, nfinit changed it */
    {
      CHANGE=(GEN)nf[2]; nf=(GEN)nf[1];
    }
    if (DEBUGLEVEL)
    {
      if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
      msgtimer("initalg");
    }
  }
  if (labs(flun)>1) 
    RES = cgetg(11,t_VEC);
  else
    RES = flun? cgetg(9,t_VEC): cgetg(8,t_VEC);
  RES[1]=nf[1]; RES[2]=nf[2];
  pgen1=cgetg(3,t_VEC); pgen1[1]=nf[3]; pgen1[2]=nf[4];
  RES[3]=(long)pgen1;
  RES[4]=nf[7];

  zu=rootsof1(nf);
  R1=itos(gmael(nf,2,1)); R2=(N-R1)>>1; RU=R1+R2;
  D=(GEN)nf[3]; drc=fabs(gtodouble(D)); LOGD=log(drc);
  lim = (long) (exp(-(double)N) * sqrt(2*PI*N*drc) * pow(4/PI,(double)R2));
  if (lim<3) lim = 3;
  cbach = min(12., gtodouble(gcbach));
  cbach2 = gtodouble(gcbach2);
  if (DEBUGLEVEL) msgtimer("rootsof1");
  av0=avma; powsubfactorbase=NULL;

INCREASEGEN:
  if (DEBUGLEVEL) fprintferr("cbach = %f\n",cbach);
  nreldep=nrelsup=0;
  LIMC = (long)(cbach*LOGD*LOGD); if (LIMC<20) LIMC=20;
  LIMC2=max(3*N, (long)(max(cbach,cbach2)*LOGD*LOGD));
  if (LIMC2 < LIMC) LIMC2=LIMC;
  if (DEBUGLEVEL)
  {
    fprintferr("N = %ld, R1 = %ld, R2 = %ld, RU = %ld\n",N,R1,R2,RU);
    fprintferr("LIMC = %ld, LIMC2 = %ld\n",LIMC,LIMC2);
    fprintferr("D = "); outerr(D);
  }

  /* Calcul de factorbase, subfactorbase et initialisation de vperm */
  lfun = factorbasegen(nf,LIMC2,LIMC);
  if (!lfun) { avma=av0; cbach=2*cbach; goto INCREASEGEN; }

  z = mulrr(lfun,gmul(gmul2n(gpuigs(shiftr(mppi(DEFAULTPREC),1),-R2),-R1),
		      gsqrt(absi(D),DEFAULTPREC)));
  vperm = cgeti(KC+1); for (i=1; i<=KC; i++) vperm[i]=i;
  ss = subfactorbasegen(N,min(lim,LIMC2),minsfb,vperm);
  if (ss == -1)
  {
    desallocate(NULL,0); avma=av0; cbach=2*cbach; goto INCREASEGEN;
  }

  /* Calcule la precision, cree matarch, affecte les relations triviales */
  PRECREGINT = 4 + ((gexpo(D)*(lgsub-2)+((N*N)>>2))>>TWOPOTBITS_IN_LONG);
  PRECREG = max(prec+1,PRECREGINT);
  KCCO = KC+RU-1 + max(ss,RELSUP);
  if (DEBUGLEVEL)
  {
    fprintferr("sous-factor base a %ld elements\n\n",lgsub-1);
    fprintferr("nbrelsup = %ld , ss = %ld , ",RELSUP,ss);
    fprintferr("KCZ = %ld , KC = %ld , KCCO = %ld \n",KCZ,KC,KCCO); flusherr();
  }
  subvperm = cgeti(lgsub); ex = cgeti(lgsub);
  for (i=1; i<lgsub; i++) subvperm[i]=vperm[i];
  mat=(long**)gpmalloc(sizeof(long*)*(KCCO+1));
  matarch=cgetg(KCCO+1,t_MAT);
  for (i=1; i<=KCCO; i++)
  {
    p1=(long *)gpmalloc(sizeof(long)*(KC+1)); mat[i]=p1;
    for (j=1; j<=KC; j++) p1[j]=0;
    pgen1=cgetg(RU+1,t_COL); matarch[i]=(long)pgen1;
    for (j=1; j<=RU; j++)
    {
      GEN p1=cgetg(3,t_COMPLEX);
      p1[1]=lgetr(PRECREG); p1[2]=lgetr(PRECREG);
      pgen1[j]=(long)p1;
    }
  }
  cmptglob=0;
  for (i=1; i<=KCZ; i++)
  {
    pgen1=idealbase[i]; n1=lg(pgen1); k=0;
    for (j=1; j<n1; j++)
      k += itos(gmael(pgen1,j,3))*itos(gmael(pgen1,j,4));
    if (k==N)
    {
      cmptglob++; ip=numideal[factorbase[i]];
      for (j=1; j<n1; j++) mat[cmptglob][ip+j]=itos(gmael(pgen1,j,3));
      for (j=1; j<=RU; j++) gaffsg(0,gmael(matarch,cmptglob,j));
    }
  }
  av1 = avma; liste = cgeti(KC+1);
  for (i=1; i<=KC; i++) liste[i]=0;
  invp = cmptglob? relationrank(mat,KC,cmptglob,liste): idmat(KC);

  /* Recherche de relations par elements de petite norme */
  cmptglob = small_norm_for_buchall(cmptglob,mat,matarch,KCCO,LIMC,N,D,RU,R1,
                                    PRECREG,nf,gborne,nbrelpid,invp,liste);
  avma = av1;

  /* Recherche de relations aleatoires */
  nlze = slim = KCCO; phase = 0; 
  powsubfactorbase = NULL; lmatt2 = NULL; matcopy = NULL;
  for (i=1; i<=cmptglob; i++)
  {
    long *col = mat[i];
    j=1; while (j<=KC && !col[j]) j++;
    col[0]=j; /* index of first non-0 elt, for already_found_relation */
  }

  av1 = avma; limpile=(av1+bot)>>1;
  if (cmptglob == KCCO) /* enough relations, initialize nevertheless */
    random_relation(0,0,0,0,0,0,0,NULL,NULL,NULL,NULL,NULL,NULL,NULL,-1);
  else
  {
    GEN maarch;
    long **ma;

    if (DEBUGLEVEL)
    {
      fprintferr("\n#### Recherche de relations aleatoires\n");
      if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
      flusherr();
    }
  LABELINT:
    if (phase == 0) { ma = mat; maarch = matarch; }
    else /* reduced the relation matrix at least once */
    {
      extrarel = nlze; slim = cmptglob+extrarel;
      setlg(extramat,extrarel+1); setlg(extramatc,extrarel+1);
      if (DEBUGLEVEL)
	fprintferr("\n(need %ld more relations)\n", extrarel);
      for (j=1; j<=extrarel; j++)
      {
	k = cmptglob+j;
	matcopy[k] = (long*) gpmalloc(sizeof(long)*(KC+1));
	for (i=1; i<=KC; i++) matcopy[k][i]=0;
      }
      maarch = extramatc - cmptglob; /* start at 0, the others at cmptglob */
      ma = matcopy;
    }
    if (!lmatt2)
    {
      lmatt2 = compute_matt2(RU,nf);
      av1 = avma;
    }
    if (!powsubfactorbase)
    {
      powsubfactgen(nf,CBUCHG+1,PRECREG,PRECREGINT);
      av1 = avma;
    }
    ss = random_relation(cmptglob,slim,LIMC,N,RU,PRECREG,PRECREGINT,nf,
                         vperm,subvperm,ma,maarch,lmatt2,ex,phase);
    if (ss == -1) /* could not find enough relations */
    {
      for (j=1; j<=KCCO; j++) free(mat[j]); free(mat);
      desallocate(matcopy,cmptglob); avma=av0;
      cbach=check_bach(cbach,12.); goto INCREASEGEN;
    }
    if (phase)
      for (j=1; j<=extrarel; j++)
      {
	long *col = matcopy[cmptglob+j];
	GEN *gcol = (GEN*) extramat[j];

	for (k=1; k<=KC; k++)
	  gcol[k] = stoi(col[vperm[k]]);
      }
    cmptglob = ss;
  }

  /* Reductions des matrices des relations */
  if (phase == 0) /* never reduced before */
  {
    matcopy=(long**)gpmalloc(sizeof(long*)*(10*KCCO+1+MAXRELSUP));
    for (j=1; j<=KCCO; j++)
    {
      p1 = (long*) gpmalloc(sizeof(long)*(KC+1));
      matcopy[j]=p1;
      for (i=0; i<=KC; i++) p1[i]=mat[j][i];
    }
    mit = hnfspec(mat,&pdep,&matarch,vperm,&matalpha,KCCO,KC,lgsub-1,
                  &nlze,&col);
    for (j=1; j<=KCCO; j++) free(mat[j]); free(mat);
    KCCOPRO = KCCO; phase = 1;
   /* keep some room for the extra relation. We will update matrix size when
    * extrarel goes down
    */
    extrarel = nlze? nlze: 1; /* in case the regulator is 0 */
    extramat =cgetg(extrarel+1,t_MAT);
    extramatc=cgetg(extrarel+1,t_MAT);
    for (j=1; j<=extrarel; j++)
    {
      extramat[j]=lgetg(KC+1,t_COL);
      extramatc[j]=lgetg(RU+1,t_COL);
      for (i=1; i<=RU; i++)
      {
	pgen1 = cgetg(3,t_COMPLEX);
	pgen1[1]=lgetr(PRECREG);
	pgen1[2]=lgetr(PRECREG);
	mael(extramatc,j,i)=(long)pgen1;
      }
    }
  }
  else
  {
    if (low_stack(limpile, (av1+bot)>>1))
    {
      GEN *gptr[6];
      if(DEBUGMEM>1) err(warnmem,"buchall");
      gptr[0]=&mit; gptr[1]=&matarch; gptr[2]=&matalpha;
      gptr[3]=&pdep; gptr[4]=&extramat; gptr[5]=&extramatc;
      gerepilemany(av1,gptr,6);
    }
    if (nrelsup) nlze=0;
    mit = hnfadd(mit,&pdep,&matarch,vperm,&matalpha,KCCOPRO,KC,col,&nlze,
                 extramat,extramatc);
    KCCOPRO += extrarel; col = KCCOPRO-(lg(matalpha)-1);
    if (nlze)
    {
      nreldep++;
      if (nreldep>MAXRELSUP)
      {
	desallocate(matcopy,cmptglob); avma=av0;
	cbach=check_bach(cbach,12.); goto INCREASEGEN;
      }
    }
  }
  if (nlze) goto LABELINT;

  /* Calcul du regulateur provisoire pour le check */
  sreg = col-lg(mit)+1; xarch=cgetg(sreg+1,t_MAT);
  for (j=1; j<=sreg; j++) xarch[j]=matarch[j];
  reg = compute_regulator(xarch,RU,R1,N,sreg,PRECREG,&sublambda);

  if (!reg) /* we don't have full rank for units */
  {
    if (DEBUGLEVEL)
    { 
      fprintferr("regulateur nul:\n");
      if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
      flusherr();
    }
    nrelsup++;
    if (nrelsup>MAXRELSUP)
    {
      desallocate(matcopy,cmptglob); avma=av0;
      cbach=check_bach(cbach,12.); goto INCREASEGEN;
    }
    nlze=1; goto LABELINT;
  }

  /* Calcul du nombre de classes */
  clh = compute_class_number(mit,&met,&u1,&u2);

  /* Calcul du check */
  p1 = gmul2n(gdiv(clh, gmul(z,(GEN)zu[1])), 1);
  c_1 = compute_check(sublambda,p1,PRECREG,&parch,&reg);
  if (! c_1)
  {
    fprintferr("\nYou are being dishonest, doubling the Bach constant\n");
    flusherr();
    desallocate(matcopy,cmptglob); avma=av0;
    cbach=check_bach(cbach,12.); goto INCREASEGEN;
  }
  if (gcmpgs(gmul2n(c_1,1),3)<0) { c_1=stoi(20); nrelsup=MAXRELSUP; }
  if (gcmpgs(c_1,3)>0)
  {
    nrelsup++;
    if (nrelsup<=MAXRELSUP)
    {
      if (DEBUGLEVEL)
      { 	
	if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
	fprintferr("\n ***** check = %f\n\n",gtodouble(c_1)/2); flusherr();
      }
      nlze=1; goto LABELINT;
    }
    if (cbach<11.99)
    { 
      desallocate(matcopy,cmptglob); avma=av0;
      cbach=check_bach(cbach,12.); goto INCREASEGEN;
    }
    err(warner,"suspicious check. Suggest increasing extra relations.");
  }
  if (DEBUGLEVEL>7) { fprintferr("$$$$$ AVMA = %ld\n",avma); flusherr(); }

  /* Phase "be honest" */
  if (KCZ2>KCZ)
  {
    if (!powsubfactorbase)
      powsubfactgen(nf,CBUCHG+1,PRECREG,PRECREGINT);
    if (! be_honest(nf,RU,PRECREGINT))
    {
      desallocate(matcopy,cmptglob); avma=av0;
      cbach=check_bach(cbach,12.); goto INCREASEGEN;
    }
  }

  /* regulateur, racines de l'unite et unites fondamentales */
  xarch=cleancol(gmul(xarch,parch),N,RU,PRECREG);
  if (labs(flun)>1)
  {
    long c;
    fu=getfu(nf,&xarch,reg,flun,&c,PRECREG);
    if (labs(flun)>2 && !c)
    {
      prec=(prec<<1)-2;
      if (DEBUGLEVEL) err(warnprec,"getfu",prec);
      desallocate(matcopy,cmptglob); avma=av;
      return buchall(P,gcbach,gcbach2,gRELSUP,gborne,nbrelpid,minsfb,flun,prec);
    }
    RES[9] = c? lmul((GEN)nf[7],fu):(long)fu;
    RES[10]=lstoi(c);
  }
  RES[6]=(long)reg; 
  RES[7]=ldiv(gmul(reg,clh),gmul((GEN)zu[1],z));
  if (flun)
  {
    pgen1=cgetg(3,t_VEC); RES[8]=(long)pgen1;
    pgen1[1]=zu[1]; pgen1[2]=lmul((GEN)nf[7],(GEN)zu[2]);
  }

  /* generateurs du groupe de classes */
  clgg = class_group_generators(PRECREG,PRECREGINT,nf,met,clh,u1,u2,vperm);
  clg1=cgetg(4,t_VEC); clg2=cgetg(4,t_VEC);
  for (i=1; i<=3; i++) { clg1[i]=clgg[i]; clg2[i]=clgg[i+3]; }
  RES[5]=(long)clg1;

  /* Nettoyage et fin */
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    fprintferr("\n#### Phase finale\n"); flusherr();
  }
  desallocate(matcopy,cmptglob); tetpil=avma;
  if (flun>=0)
  { 
    z=cgetg(2,t_MAT); z[1]=lcopy(RES);
    settyp(z[1], t_COL); return gerepile(av,tetpil,z);
  }

  if (CHANGE) { p1 = cgetg(3,t_VEC); p1[2]=lcopy(CHANGE); CHANGE = p1; }
  z=cgetg(11,t_VEC);
  z[1]=lcopy(mit);
  z[2]=lcopy(matalpha);
  z[3]=lcopy(xarch);
  
  k = lg(matarch)-sreg;
  p1=cgetg(k,t_MAT);
  for (j=1; j<k; j++)
    p1[j]=(long)cleancol((GEN)matarch[j+sreg],N,RU,PRECREG);
  z[4]=(long)p1;
  z[5]=lcopy(vectbase);
  
  p1=cgetg(KC+1,t_COL);
  for (i=1; i<=KC; i++) p1[i]=lstoi(vperm[i]);
  z[6]=(long)p1;
  z[7]=lcopy(nf);

  i = (flun==-1)? 4: 6; p1=cgetg(i+1,t_VEC);
  for ( ; i; i--) p1[i]=lcopy((GEN)RES[i+4]);
  z[8]=(long)p1;
  z[9]=lcopy(clg2);
  z[10]=zero; /* dummy: we MUST have lg(bnf) != lg(nf) */
  if (CHANGE) { CHANGE[1]=(long)z; z = CHANGE; }
  return gerepile(av,tetpil,z);
}

/* cree subfactorbase et lgsub. Modifie vperm. Renvoie ss = le nombre de
 * premier dont on a retenu tous les diviseurs dans la factorbase.
 */
static long
subfactorbasegen(long N,long m,long minsfb,long *vperm)
{
  long av=avma,tetpil,i,j, k=lg(vectbase)-1,s=0,s1=0,nbidp=0,ss=0;
  GEN y,y1,y2,perm,perm1;
  double prod;

  y=cgetg(k+1,t_COL); y1=cgetg(k+1,t_COL); y2=cgetg(k+1,t_COL);
  for (i=1; i<=k; i++)
  {
    GEN p1=(GEN)vectbase[i];
    long e,s2;

    y2[i]=lpui((GEN)p1[1],(GEN)p1[4],0);
    if (i>1 && cmpii((GEN)p1[1],gmael(vectbase,i-1,1)))
    { 
      if (s==N) y1[i-1]=zero;
      if (s1==N) ss++;
      s=0; s1=0;
    }
    e = itos((GEN)p1[3]); s2 = e*itos((GEN)p1[4]); s1 += s2;
    if (e>1) { y1[i]=zero; s=0; } else { y1[i]=y2[i]; s += s2; }
  }
  if (s==N) y1[k]=zero;
  if (s1==N) ss++;
  perm=sindexsort(y1);
  i=1; while (i<=k && !signe(y1[perm[i]])) i++;
  if (i>k+1-minsfb) { avma=av; return -1; }

  prod=1.0;
  while ((nbidp<=(k-i) && prod<m+0.5) || nbidp<minsfb)
  { 
    nbidp++;
    prod *= gtodouble((GEN)y1[perm[nbidp+i-1]]);
  }
  if (prod<m) { avma=av; return -1; }
  for (j=1; j<=nbidp; j++)
    y2[perm[j+i-1]]=zero;
  perm1=sindexsort(y2);
  for (j=1; j<=nbidp; j++) vperm[j]=perm[j+i-1];
  for (   ; j<=k; j++) vperm[j]=perm1[j];

  tetpil=avma; y=cgetg(nbidp+1,t_COL);
  for (j=1; j<=nbidp; j++)
    y[j]=lcopy((GEN)vectbase[perm[j+i-1]]);
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    if (DEBUGLEVEL>3)
    {
      fprintferr("\n***** LISTE DES IDEAUX DE LA FACTEUR BASE *****\n\n");
      for (i=1; i<=KC; i++)
	{ fprintferr("no %ld = ",i); outerr((GEN)vectbase[i]); }
      fprintferr("\n***** LISTE DES IDEAUX DE LA SOUS-FACTEUR BASE *****\n\n");
      outerr(y);
      fprintferr("\n***** PERMUTATION D'ORIGINE *****\n\n");
      for (i=1; i<=KC; i++) fprintferr("vperm[%ld] = %ld\n",i,vperm[i]);
      fprintferr("\n");
    }
    msgtimer("subfactorbase");
  }
  subfactorbase = gerepile(av,tetpil,y);
  lgsub = lg(subfactorbase); return ss;
}

static GEN
mulred(GEN nf,GEN x, GEN vp, long prec,long precint)
{
  long av = avma,tetpil;
  GEN  y = cgetg(3,t_VEC);
  y[1] = (long)idealmulprime(nf,(GEN)x[1],vp);
  y[2] = x[2]; tetpil=avma;
  y = ideallllredall(nf,y,gzero,prec,precint);
  return gerepile(av,tetpil,y);
}

/* Calcule la table des puissances des ideaux premiers de la base des
 * sous-facteurs; a est l'exposant maximum calcule. Renvoie une matrice x
 * de GEN, x[j][i] contenant l'ideal (P_i)^j, sous forme HNF
 */
static void
powsubfactgen(GEN nf,long a,long prec,long precint)
{
  long i,j,n=lgsub-1,N=lgef(nf[1])-3,RU;
  GEN z,id;

  powsubfactorbase = (GEN**) gpmalloc(sizeof(GEN*)*(n+1));

  if (DEBUGLEVEL)
  {
    fprintferr("Calcul des puissances de la sub-factor base :\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  RU=itos(gmael(nf,2,1)); RU = RU + (N-RU)/2;
  for (i=1; i<=n; i++)
    powsubfactorbase[i]=(GEN*)gpmalloc(sizeof(GEN)*(a+1));
  id=cgetg(3,t_VEC); id[1]=(long)idmat(N);
  z=cgetg(RU+1,t_VEC); for (i=1; i<=RU; i++) z[i]=zero;
  id[2]=(long)z;

  for (i=1; i<=n; i++)
  {
    powsubfactorbase[i][0]=id;
    if (a) 
    {
      powsubfactorbase[i][1] = cgetg(3,t_VEC);
      powsubfactorbase[i][1][1] = 
        (long) prime_to_ideal(nf,(GEN)subfactorbase[i]);
      powsubfactorbase[i][1][2] = (long) z;
    }
    if (DEBUGLEVEL>=2)
    { 
      fprintferr(" 0");
      if (a) fprintferr(" 1");
    }
    for (j=2; j<=a; j++)
    {
      powsubfactorbase[i][j] = mulred(nf,powsubfactorbase[i][j-1],
                                      (GEN)subfactorbase[i],prec,precint);
      if (DEBUGLEVEL>=2) fprintferr(" %ld",j);
    }
    if (DEBUGLEVEL>=2) { fprintferr("\n"); flusherr(); }
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7)
    {
      fprintferr("$$$$$ AVMA = %ld\n\n",avma);
      fprintferr("**** LISTE DES PUISSANCES DE LA SOUS-FACTEUR BASE ****\n\n");
      for (i=1; i<=n; i++)
      {
	for (j=0; j<=a; j++)
	{ 
	  fprintferr("powsubfactorbase[%ld][%ld] = ",i,j);
	  outerr(powsubfactorbase[i][j]);
	}
	fprintferr("\n");
      }
    }
    msgtimer("powsubfactgen");
  }
}

/* Calcul de la base de facteurs: 
 *   n2 est la borne pour les nombres premiers qui vont etre testes pour
 * obtenir toutes les relations et la norme des ideaux choisis.
 *   n est la borne des nombres premiers qui vont etre testes pour les
 * relations primaires (constante de Bach).
 * 
 * Cree factorbase, numfactorbase, idealbase, vectbase, numideal.
 * Renvoie prod_{p<=n2} [ (1-1/p).prod_{P|p,Norm(P)<=n2} (1-1/Norm(P)) ]
 */
static GEN
factorbasegen(GEN nf,long n2,long n)
{
  byteptr delta=diffptr;
  long av1,tetpil,i,j,k,p,lon,ip,ip0;
  GEN prim,p1,NormP,lfun;

  numfactorbase= (long*)gpmalloc(sizeof(long)*(n2+1));
  factorbase   = (long*)gpmalloc(sizeof(long)*(n2+1));
  numideal     = (long*)gpmalloc(sizeof(long)*(n2+1));
  idealbase    = (GEN *)gpmalloc(sizeof(GEN )*(n2+1));

  lfun=cgetr(DEFAULTPREC); affsr(1,lfun);
  i=0; p=*delta++; ip=0; KC=0;
  while (p<=n2)
  {
    av1=avma; prim=stoi(p);
    if (DEBUGLEVEL>=2) { fprintferr(" %ld",p); flusherr(); }
    p1=primedec(nf,prim);
    lon=lg(p1); divrsz(mulsr(p-1,lfun),p,lfun);
    if (lon>2 || cmpis(gmael(p1,1,3),1) > 0)
    {
      ip0=ip;
      for (j=0,k=1; k<lon; k++)
      {
	NormP=gpui(prim,gmael(p1,k,4),0);
	if (cmpis(NormP,n2)>0) break; 

        ip++; j++;
        divriz(mulir(NormP,lfun),subis(NormP,1),lfun);
      }
      i++; numfactorbase[p]=i; factorbase[i]=p;
      numideal[p]=ip0; tetpil=avma; setlg(p1,j+1);
      /* keep all ideals with Norm <= n2 */
      idealbase[i]=gerepile(av1,tetpil,gcopy(p1));
    }
    else /* p inert */
    {
      NormP=gpui(prim,gmael(p1,1,4),0);
      if (cmpis(NormP,n2)<=0)
	divriz(mulir(NormP,lfun),subis(NormP,1),lfun);
    }
    p += *delta++;
    if (KC == 0 && p>n) { KCZ=i; KC=ip; }
  }
  if (!KC)
  {
    free(numfactorbase); free(factorbase);
    free(numideal); free(idealbase); return NULL;
  }

  KCZ2=i; KC2=ip; MAXRELSUP = min(50,4*KC); 
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>=2) fprintferr("\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    if (DEBUGLEVEL>6)
    { 
      for (i=1; i<=KCZ; i++)
	{ fprintferr("++ idealbase[%ld] = ",i); outerr(idealbase[i]); }
    }
    if (DEBUGLEVEL>7)
    {
      fprintferr("########## FACTORBASE ##########\n\n");
      fprintferr("KC2=%ld , KC=%ld , KCZ=%ld , KCZ2=%ld, MAXRELSUP=%ld\n",
                  KC2, KC, KCZ, KCZ2,MAXRELSUP);
      for (i=1; i<=KCZ; i++)
	{ fprintferr("++ idealbase[%ld] = ",i); outerr(idealbase[i]); }
    }
    msgtimer("factor base");
  }
  vectbase=cgetg(KC+1,t_COL);
  for (i=1; i<=KCZ; i++)
  {
    ip=numideal[factorbase[i]]; p1=idealbase[i]; k=lg(p1);
    for (j=1; j<k; j++) vectbase[ip+j]=p1[j];
  }
  return lfun;
}

static long
factorisegen(GEN nf,GEN idealvec,long kcz,long limp)
{
  long i,j,n1,ip,v,p,k,av1,lo,ifinal;
  GEN x,q,r,p1,listexpo,ideal=(GEN)idealvec[1];

  av1=avma; lo=0; x = gcoeff(ideal,1,1);
  for (i=2; i<lg(ideal); i++) x = mulii(x,gcoeff(ideal,i,i));
  x = gdiv((GEN)idealvec[3],x);
  if (gcmp1(x)) { avma=av1; primfact[0]=0; return 1; }
  listexpo=cgeti(kcz+1);
  for (i=1; ; i++)
  {
    p=factorbase[i]; q=dvmdis(x,p,&r);
    for (k=0; !signe(r); k++) { x=q; q=dvmdis(x,p,&r); }
    listexpo[i] = k;
    if (cmpis(q,p)<=0) break;
    if (i==kcz) { avma=av1; return 0; }
  }
  if (cmpis(x,limp) > 0) { avma=av1; return 0; }

  ifinal=i;
  for (i=1; i<=ifinal; i++)
  {
    k = listexpo[i];
    if (k)
    {
      p = factorbase[i]; p1 = idealbase[numfactorbase[p]];
      n1=lg(p1); ip = numideal[p];
      for (j=1; j<n1; j++)
      {
	v = idealval(nf,ideal,(GEN)p1[j]) -
	  element_val2(nf,(GEN)idealvec[2],(GEN)idealvec[3],(GEN)p1[j]);
	if (v)
	{
	  primfact[++lo]=ip+j; expoprimfact[lo]=v;
	  k += v * itos(gmael(p1,j,4));
	  if (!k) break;
	}
      }
      if (k) { avma=av1; return 0; }
    }
  }
  if (gcmp1(x)) { avma=av1; primfact[0]=lo; return 1; }

  p = itos(x); p1 = idealbase[numfactorbase[p]];
  n1 = lg(p1); ip = numideal[p];
  for (k=1,j=1; j<n1; j++)
  {
    v=idealval(nf,ideal,(GEN)p1[j]) -
	element_val2(nf,(GEN)idealvec[2],(GEN)idealvec[3],(GEN)p1[j]);
    if (v)
    {
      primfact[++lo]=ip+j; expoprimfact[lo]=v;
      k += v*itos(gmael(p1,j,4));
      if (!k) { avma=av1; primfact[0]=lo; return 1; }
    }
  }
  avma=av1; return 0;
}

static long
factorisealpha(GEN nf,GEN alpha,long kcz,long limp)
{
  long i,j,n1,ip,v,p,k,av1,lo,ifinal;
  GEN d,x,q,r,p1,listexpo;

  av1=avma; lo=0;
  d=x=absi(subres(gmul((GEN)nf[7],alpha),(GEN)nf[1]));
  if (gcmp1(x)) { avma=av1; primfact[0]=0; return 1; }
  listexpo=cgeti(kcz+1);
  for (i=1; ; i++)
  {
    p=factorbase[i]; q=dvmdis(x,p,&r);
    for (k=0; !signe(r); k++) { x=q; q=dvmdis(x,p,&r); }
    listexpo[i] = k;
    if (cmpis(q,p)<=0) break;
    if (i==kcz) { avma=av1; return 0; }
  }
  if (cmpis(x,limp) > 0) { avma=av1; return 0; }

  ifinal=i;
  for (i=1; i<=ifinal; i++)
  {
    k = listexpo[i];
    if (k)
    { 
      p = factorbase[i]; p1 = idealbase[numfactorbase[p]];
      n1=lg(p1); ip = numideal[p];
      for (j=1; j<n1; j++)
      {
	v=element_val2(nf,alpha,d,(GEN)p1[j]);
	if (v)
	{
	  primfact[++lo]=ip+j; expoprimfact[lo]=v;
	  k -= v * itos(gmael(p1,j,4));
	  if (!k) break;
	}
      }
      if (k) { avma=av1; return 0; }
    }
  }
  if (gcmp1(x)) { avma=av1; primfact[0]=lo; return 1; }

  p=itos(x); p1 = idealbase[numfactorbase[p]];
  n1=lg(p1); ip = numideal[p];
  for (k=1,j=1; j<n1; j++)
  {
    v=element_val2(nf,alpha,d,(GEN)p1[j]);
    if (v)
    {
      primfact[++lo]=ip+j; expoprimfact[lo]=v;
      k -= v*itos(gmael(p1,j,4));
      if (!k) { avma=av1; primfact[0]=lo; return 1; }
    }
  }
  avma=av1; return 0;
}

static GEN
cleancol(GEN x,long N,long RU,long PRECREG)
{
  long i,j,av,tetpil,tx=typ(x),R1;
  GEN s,s2,p1,p2,p3,p4,y;

  if (tx==t_MAT)
  {
    y=cgetg(lg(x),tx);
    for (j=1; j<lg(x); j++)
      y[j]=(long)cleancol((GEN)x[j],N,RU,PRECREG);
    return y;
  }
  if (!is_vec_t(tx)) err(talker,"not a vector/matrix in cleancol");
  av = avma; R1 = (RU<<1)-N;
  p1=greal(x); s=(GEN)p1[1]; for (i=2; i<=RU; i++) s=gadd(s,(GEN)p1[i]);
  s=gdivgs(s,-N); if (N>R1) s2=gmul2n(s,1);
  p2=gmul2n(mppi(PRECREG),2); p3=gimag(x);
  tetpil=avma; y=cgetg(RU+1,tx);
  for (i=1; i<=RU; i++)
  {
    p4=cgetg(3,t_COMPLEX); y[i]=(long)p4;
    p4[1]=ladd((GEN)p1[i], (i<=R1)?s:s2);
    p4[2]=lmod((GEN)p3[i],p2);
  }
  return gerepile(av,tetpil,y);
}

#define RELAT 0
#define LARGE 1
#define PRECI 2
static GEN
not_given(long av, long flun, long reason)
{
  if (labs(flun)==2)
  {
    char *s=NULL;
    switch(reason)
    {
      case RELAT:
        s = "not enough relations for fundamental units, not given"; break;
      case LARGE:
        s = "fundamental units too large, not given"; break;
      case PRECI:
        s = "insufficient precision for fundamental units, not given"; break;
    }
    err(warner,s);
  }
  avma=av; return cgetg(1,t_MAT);
}

static GEN
getfu(GEN nf,GEN *ptxarch,GEN reg,long flun,long *pte,long PRECREG)
{
  long av=avma,i,j,RU,N=lgef(nf[1])-3,e,R1,R2;
  GEN pol,p1,p2,p3,y,matep,s,xarch,vec;
  GEN *gptr[2];

  if (DEBUGLEVEL)
  {
    fprintferr("\n#### Calcul des unites fondamentales\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  R1=itos(gmael(nf,2,1)); R2=(N-R1)>>1; RU=R1+R2;
  if (RU==1) { *pte=BIGINT; return cgetg(1,t_MAT); }

  *pte = 0; xarch=*ptxarch;
  if (gexpo(reg)<-8) return not_given(av,flun,RELAT);

  matep=cgetg(RU,t_MAT);
  for (j=1; j<RU; j++)
  {
    s=gzero; for (i=1; i<=RU; i++) s=gadd(s,greal(gcoeff(xarch,i,j)));
    s=gdivgs(s,N);
    p1=cgetg(N+1,t_COL); matep[j]=(long)p1;
    for (i=1; i<=R1; i++)
      p1[i]=lsub(gcoeff(xarch,i,j),s);
    for (i=R1+1; i<=RU; i++)
    {
      p1[i]=lsub(gmul2n(gcoeff(xarch,i,j),-1),s);
      p1[i+R2]=lconj((GEN)p1[i]);
    }
  }
  p1 = lllintern(greal(matep),1,PRECREG);
  if (!p1) return not_given(av,flun,PRECI);
  p2 = gmul(matep,p1);
  if (gexpo(p2) > 20) return not_given(av,flun,LARGE);
  matep=gexp(p2,PRECREG);
  xarch=gmul(xarch,p1);

  p1=gmael(nf,5,1);
  p2=cgetg(N+1,t_MAT);
  for (j=1; j<=N; j++)
  {
    p3=cgetg(N+1,t_COL); p2[j]=(long)p3;
    for (i=1; i<=R1; i++) p3[i]=coeff(p1,i,j);
    for (   ; i<=RU; i++)
    {
      p3[i]=coeff(p1,i,j);
      p3[i+R2]=lconj((GEN)p3[i]);
    }
  }
  y=greal(grndtoi(gauss(p2,matep),&e));
  if (e>=0) return not_given(av,flun,PRECI);
  *pte = -e; pol = (GEN) nf[1]; 
  p1 = cgetg(3,t_COMPLEX);
  p1[1] = zero; p1[2] = lmppi(PRECREG);  /* p1 = i * pi */
  if (R1<RU) p2 = gshift(p1,1);
  vec = cgetg(RU+1,t_COL);
  for (i=1; i<=R1; i++) vec[i]=(long)p1;
  for (   ; i<=RU; i++) vec[i]=(long)p2;
  p3=cgetg(N+1,t_COL);

  for (j=1; j<lg(y); j++)
  {
    p1=(GEN)y[j]; p2=ginvmod(gmul((GEN)nf[7],p1), pol);
    for (i=1; i<lgef(p2)-1; i++) p3[i]=p2[i+1];
    for (   ; i<=N; i++) p3[i]=zero;
    p2=gmul((GEN)nf[8],p3);
    if (gcmp(gnorml2(p2),gnorml2(p1))<0)
    {
      p1=p2; xarch[j]=lneg((GEN)xarch[j]);
    }
    i=N; while (i>=1 && gcmp0((GEN)p1[i])) i--;
    if (gsigne((GEN)p1[i])>=0) y[j]=(long)p1;
    else
    {
      y[j]=lneg(p1);
      xarch[j]=ladd((GEN)xarch[j],vec);
    }
  }
  p1=gmul((GEN)nf[7],y);
  for (j=1; j<lg(y); j++)
    if (!gcmp1(gabs(gnorm(gmodulcp((GEN)p1[j],pol)),0)))
      { *pte = 0; return not_given(av,flun,LARGE); }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    msgtimer("getfu");
  }
  *ptxarch=xarch; gptr[0]=ptxarch; gptr[1]=&y;
  gerepilemany(av,gptr,2); return y;
}
#undef RELAT
#undef LARGE
#undef PRECI

GEN
buchfu(GEN bnf)
{
  GEN nf,xarch,reg,res,fu,y;
  long av=avma,tetpil,c,RU;

  checkbnf(bnf); nf = checknf(bnf);
  RU=itos(gmael(nf,2,1))+itos(gmael(nf,2,2));
  res=(GEN)bnf[8];
  if (lg(res)==7 && lg(res[5])==RU)
  { 
    y=cgetg(3,t_VEC); y[1]=lcopy((GEN)res[5]);
    y[2]=lcopy((GEN)res[6]); return y;
  }

  xarch=(GEN)bnf[3]; reg=(GEN)res[2];
  fu=getfu(nf,&xarch,reg,2,&c,gprecision(xarch));
  tetpil=avma; y=cgetg(3,t_VEC);
  y[1]=c?lmul((GEN)nf[7],fu):lcopy(fu); y[2]=lstoi(c);
  return gerepile(av,tetpil,y);
}

static long
factorisegensimple(GEN nf,GEN ideal)
{
  long i,v,av1 = avma,lo;
  GEN x = gcoeff(ideal,1,1);

  for (i=2; i<lg(ideal); i++) x = mulii(x,gcoeff(ideal,i,i));
  if (gcmp1(x)) { avma=av1; primfact[0]=0; return 1; }
  for (lo=0, i=1; i<lg(vectbase); i++)
  {
    GEN p1=(GEN)vectbase[i], p=(GEN)p1[1];
    if (!smodis(x,itos(p))) /* if p | x */
    {
      v=idealval(nf,ideal,p1);
      if (v)
      {
	lo++; primfact[lo]=i; expoprimfact[lo]=v;
	x = divii(x, gpuigs(p, v * itos((GEN)p1[4])));
	if (gcmp1(x)) { avma=av1; primfact[0]=lo; return 1; }
      }
    }
  }
  avma=av1; primfact[0]=lo; return 0;
}

#define MAXITER 50

static GEN
isprincipalall0(GEN bnfold, GEN xold, GEN RESINITIAL, long pr, long flall)
{
  long av=avma,*vinvperm, ex[3];
  long i,j,fpc,colmit,colnew,k,N,R1,R2,RU,e,c,nbtest,bou,vperm1,vperm2;
  GEN xinit,id,xalpha,yalpha,mit,matalpha,matunit,matalphac,vperm,nf;
  GEN u1,u2,y,p1,p2,p3,p4,p5,s,s1,s2,om1,om2,om3,xar,pgen1,pgen2,ideal,vdir;
  GEN detp5,p5min,detpgen1,cycliclist,u1inv,baseclorig,clg2,a,RES;
  GEN mata,veca,u1u2,u,u4,p2new, x = xold, bnf = bnfold;

  if (!RESINITIAL) RESINITIAL=(GEN)bnf[8]; /* original call */
  else
  {
    if (DEBUGLEVEL) err(warnprec,"isprincipalall0",pr);
    i=DEBUGLEVEL; DEBUGLEVEL=max(0,DEBUGLEVEL-2);
    nf=smallbuchinit(bnf,gzero,gzero,gzero,gzero,0,0,0);
    bnf=bnfmake(nf,pr); DEBUGLEVEL=i;
  }

  mit = (GEN)bnf[1];
  matalpha = (GEN)bnf[2];
  matunit = (GEN)bnf[3];
  matalphac = dummycopy((GEN)bnf[4]);
  vectbase = (GEN)bnf[5];
  vperm = (GEN)bnf[6];
  nf = (GEN)bnf[7];
  N=lgef(nf[1])-3; id=idmat(N);
  RES=(GEN)bnf[8];
  clg2=(GEN)bnf[9];

  R1=itos(gmael(nf,2,1)); R2=(N-R1)>>1; RU=R1+R2;
  pr = gprecision((GEN)matalphac[1]);
  if (!pr) pr = BIGDEFAULTPREC;

  colmit=lg(mit)-1; colnew=lg(matalpha)-1;
  a=content(x); if (!gcmp1(a)) x=gdiv(x,a);
  xinit = x = hnfmod(x,detint(x));
  vinvperm = cgeti(lg(vectbase));
  for (i=1; i<lg(vectbase); i++) vinvperm[itos((GEN)vperm[i])]=i;
  vperm1=itos((GEN)vperm[1]);
  vperm2=itos((GEN)vperm[2]);
  s=gcoeff(x,1,1); for (i=2; i<=N; i++) s=mulii(s,gcoeff(x,i,i));
  xar=cgetg(RU+1,t_VEC); for (i=1; i<=RU; i++) xar[i]=zero;
  nbtest=0;
  if (! factorisegensimple(nf,x))
  {
    p3=cgetg(3,t_VEC); p3[1]=(long)x; p3[2]=(long)xar;
    p1=ideallllred(nf,p3,gzero,pr);
    x=(GEN)p1[1]; fpc=factorisegensimple(nf,x);
    if (!fpc)
    {
      vdir=cgetg(RU+1,t_VEC); for (i=1; i<=RU; i++) vdir[i]=zero;
      for (i=1; i<=RU && !fpc; i++)
      {
	vdir[i]=lstoi(10); p1=ideallllred(nf,p3,vdir,pr);
	x=(GEN)p1[1]; fpc=factorisegensimple(nf,x);
	vdir[i]=zero;
      }
      while (!fpc)
      {
	for (i=1; i<=2; i++) ex[i] = mymyrand() >> randshift;
	ideal=idealpowred_prime(nf,(GEN)vectbase[vperm1],stoi(ex[1]),pr);
	pgen1=idealpowred_prime(nf,(GEN)vectbase[vperm2],stoi(ex[2]),pr);
	ideal=idealmulh(nf,idealmul(nf,p3,ideal),pgen1);
	for (i=1; i<=RU; i++) vdir[i] = lstoi(mymyrand() >> randshift);
	for (bou=1; bou<=RU; bou++)
	{
	  if (bou!=1)
	  {
	    for (i=1; i<=RU; i++) vdir[i]=zero;
	    vdir[bou]=lstoi(10);
	  }
	  p1=ideallllred(nf,ideal,vdir,pr); nbtest++;
	  if (DEBUGLEVEL>2)
	  {
	    fprintferr("nbtest = %ld, ideal = ",nbtest);
	    outerr((GEN)p1[1]);
	  }
	  x=(GEN)p1[1]; fpc=factorisegensimple(nf,x);
	  if (fpc) break;
	  if (nbtest == MAXITER)
	  {
	    if (flall & nf_FORCE)
	    {
	      pr=2*pr-2; avma=av;
	      return isprincipalall0(bnfold,xold,RESINITIAL,pr,flall);
	    }
	    err(talker,"too many iterations in isprincipal");
	  }
	}
      }
    }
    xar=cleancol((GEN)p1[2],N,RU,pr);
  }
  xalpha=cgetg(colmit+1,t_COL); yalpha=cgetg(colnew+1,t_COL);
  for (i=1; i<=colmit; i++) xalpha[i]=zero;
  for (i=1; i<=colnew; i++) yalpha[i]=zero;
  if (nbtest)
  {
    for (i=1; i<=2; i++)
    {
      if (i<=colmit) xalpha[i]=lstoi(-ex[i]);
      else yalpha[i-colmit]=lstoi(-ex[i]);
    }
  }
  for (i=1; i<=primfact[0]; i++)
  {
    k=vinvperm[primfact[i]];
    if (k<=colmit) xalpha[k]=laddsg(expoprimfact[i],(GEN)xalpha[k]);
    else yalpha[k-colmit]=laddsg(expoprimfact[i],(GEN)yalpha[k-colmit]);
  }
  u1inv=(GEN)clg2[1]; /* inverse de u1, u1*mit*u2=diag(cycliclist_i) */
  u2=(GEN)clg2[2];
  cycliclist=gmael(RES,1,2);
  u1=ginv(u1inv); c=lg(cycliclist)-1;
  p1=gmul(u1,gsub(xalpha,gmul(matalpha,yalpha)));
  p4=cgetg(colmit+colnew+1,t_COL); p2=cgetg(c+1,t_COL);
  for (i=1; i<=c; i++)
  {
    p4[i]=(long)dvmdii((GEN)p1[i],(GEN)cycliclist[i],(GEN*)(p2+i));
    if (signe(p2[i])<0)
    {
      p2[i]=ladd((GEN)p2[i],(GEN)cycliclist[i]);
      p4[i]=laddgs((GEN)p4[i],-1);
    }
  }
  if (flall & nf_GEN)
  {
    for (; i<=colmit; i++) p4[i]=p1[i];
    for (; i<=colmit+colnew; i++) p4[i]=yalpha[i-colmit];
    p5=cgetg(colmit+1,t_MAT);
    for (i=1; i<=colmit; i++) p5[i]=matalphac[i];
    p3=gmul(p5,u2); 
    for (i=1; i<=colmit; i++) matalphac[i]=p3[i];
    settyp(xar,t_COL); p1=gsub(gmul(matalphac,p4),xar);
    p4=cgetg(c+1,t_MAT);
    baseclorig=(GEN)clg2[3];
    for (j=1; j<=c; j++)
    {
      p5=(GEN)baseclorig[j];
      detp5=det((GEN)p5[1]); p5min=p5; pgen1=p5;
      pgen2=idealinv(nf,pgen1); pgen2[1]=(long)numer((GEN)pgen2[1]);
      detpgen1=det((GEN)pgen2[1]);
      if (gcmp(detpgen1,detp5)<0){ detp5=detpgen1; p5min=pgen2; }
      pgen2=ideallllredall(nf,pgen2,gzero,pr,pr);
      detpgen1=det((GEN)pgen2[1]);
      if (gcmp(detpgen1,detp5)<0){ detp5=detpgen1; p5min=pgen2; }
      p5=p5min;
      if (!gegal((GEN)p5[1],gmael3(RES,1,3,j)))
	err(talker,"bug1 in isprincipal");
      p4[j]=lneg((GEN)p5[2]); settyp(p4[j],t_COL);
    }
    p1=cleancol(c?gadd(p1,gmul(p4,p2)):p1,N,RU,pr);
    if (RU>1)
    {
      s2=gzero; p4=cgetg(RU+1,t_MAT);
      for (j=1; j<RU; j++)
      {
	p5=cgetg(RU+1,t_COL); p4[j]=(long)p5;
	s1=gzero;
	for (i=1; i<RU; i++)
	{
	  p5[i] = lreal(gcoeff(matunit,i,j));
	  s1 = gadd(s1,gsqr((GEN)p5[i]));
	}
	p5[RU]=zero; if (gcmp(s1,s2)>0) s2=s1;
      }
      p5=cgetg(RU+1,t_COL); p4[RU]=(long)p5;
      for (i=1; i<RU; i++) p5[i]=lreal((GEN)p1[i]);
      s2=gsqrt(gmul2n(s2,RU+1),pr);
      if (gcmpgs(s2,100000000)<0) s2=stoi(100000000);
      p5[RU]=(long)s2;
      p4=(GEN)lll(p4,pr)[RU];
      if (signe(p4[RU]) < 0) p4 = gneg(p4);
      if (!gcmp1((GEN)p4[RU]))
        err(talker,"bug2 in isprincipal");
      setlg(p4,RU);
      p1 = gadd(p1, gmul(matunit,p4));
    }
    s2=gun;
    for (j=1; j<=c; j++)
    {
      p5=gmael3(RES,1,3,j);
      s1=gun; for (i=1; i<=N; i++) s1=mulii(s1,gcoeff(p5,i,i));
      if (signe(p2[j])) s2 = mulii(s2,gpui(s1,(GEN)p2[j],0));
    }
    s=gdivgs(glog(gdiv(s,s2),pr),N);
    p4=cgetg(N+1,t_COL);
    for (i=1; i<=R1; i++) p4[i]=lexp(gadd(s,(GEN)p1[i]),pr);
    for (   ; i<=RU; i++)
    {
      p4[i]=lexp(gadd(s,gmul2n((GEN)p1[i],-1)),pr); ;
      p4[i+R2]=lconj((GEN)p4[i]);
    }
    om1=gmael(nf,5,1); om2=cgetg(N+1,t_MAT);
    for (j=1; j<=N; j++)
    {
      om3=cgetg(N+1,t_COL); om2[j]=(long)om3;
      for (i=1; i<=R1; i++) om3[i]=coeff(om1,i,j);
      for (   ; i<=RU; i++)
      {
	om3[i]=coeff(om1,i,j);
	om3[i+R2]=lconj((GEN)om3[i]);
      }
    }
    p1=gdiv(grndtoi(gmul(s2,greal(gauss(om2,p4))),&e),s2);
    if (e<0)
    {
      p3=cgetg(2,t_MAT); p3[1]=(long)p1;
      p5=gmael(RES,1,3);
      if (!c) p3=idealmul(nf,p3,id);
      else
	for (j=1; j<=c; j++)
	  p3=idealmul(nf,p3,idealpow(nf,(GEN)p5[j],(GEN)p2[j]));
      if (!gegal(xinit,p3)) e=0;
    }
    y=cgetg(4,t_VEC);
    if (e>=0)
    {
      if (flall & nf_FORCE)
      {
	pr=2*pr-2; avma=av;
	return isprincipalall0(bnfold,xold,RESINITIAL,pr,flall);
      }
      err(warner,"insufficient precision for generators, not given");
      y[2]=lgetg(1,t_COL); y[3]=zero;
    }
    else
    { 
      y[2]=lmul(a,p1); y[3]=lstoi(-e);
    }
    y[1]=lcopy(p2); 
  }
  else y=gcopy(p2);

  p5=gmael(RESINITIAL,1,3);
  if (!gegal(gmael(RES,1,3),p5))
  {
    if (DEBUGLEVEL>=2){ fprintferr("computing new coordinates\n"); flusherr(); }
    mata=cgetg(c+1,t_MAT); veca=cgetg(c+1,t_VEC);
    for (j=1; j<=c; j++)
    {
      p1=isprincipalall(bnf,(GEN)p5[j], nf_GEN & nf_FORCE);
      mata[j]=p1[1]; veca[j]=p1[2];
    }
    u1u2=hnfall(concatsp(diagonal(cycliclist),mata)); u=(GEN)u1u2[2];
    if (!gcmp1(det((GEN)u1u2[1]))) err(talker,"bug3 in isprincipal");
    u2=cgetg(c+1,t_MAT);
    for (j=1; j<=c; j++)
    { 
      p1=cgetg(c+1,t_COL); u2[j]=(long)p1;
      for (i=1; i<=c; i++) p1[i]=coeff(u,i,j+c);
    }
    u4=cgetg(c+1,t_MAT);
    for (j=1; j<=c; j++)
    { 	
      p1=cgetg(c+1,t_COL); u4[j]=(long)p1;
      for (i=1; i<=c; i++) p1[i]=coeff(u,i+c,j+c);
    }
    p2new=gmul(u4,p2);
    p4=cgetg(c+1,t_VEC);
    for (i=1; i<=c; i++)
    {
      p4[i]=ldvmdii((GEN)p2new[i],(GEN)cycliclist[i],(GEN*)(p2+i));
      if (signe(p2[i])<0)
      {
	p2[i]=ladd((GEN)p2[i],(GEN)cycliclist[i]);
	p4[i]=laddgs((GEN)p4[i],-1);
      }
    }
    if (flall & nf_GEN) err(impl,"isprincipalgenforce");
    y=gcopy(p2);
  }
  return y;
}

GEN
isprincipalall(GEN bnf,GEN x,long flag)
{
  long av = avma,c, tx = typ(x);
  GEN nf,y;

  if (typ(bnf)!=t_VEC || lg(bnf)!=11)
    err(talker,"not a big number field vector in isprincipal");
  nf = checknf(bnf);
  if (tx==t_POLMOD || tx==t_POL)
  {
    if (tx==t_POLMOD)
    {
      if (!gegal((GEN)x[1],(GEN)nf[1]))
	err(talker,"not the same number field in isprincipal");
      x=(GEN)x[2];
    }
    if (!(flag & nf_GEN)) { avma=av; return cgetg(1,t_COL); }

    y=cgetg(4,t_VEC); c = lg(mael3(bnf,8,1,2))-1;
    y[1]=(long)zerocol(c);
    y[2]=(long)algtobasis(nf,x);
    y[3]=lstoi(BIGINT); return y;
  }
  x = idealhermite(nf,x);
  if (lg(x)==1) err(talker,"zero ideal in isprincipal");
  if (lgef(nf[1])==4)
  {
    if (!(flag & nf_GEN)) { avma=av; return cgetg(1,t_COL); }

    y=cgetg(4,t_VEC); 
    y[1]=lgetg(1,t_COL);
    y[2]=x[1];
    y[3]=lstoi(BIGINT); return y;
  }
  return gerepileupto(av, isprincipalall0(bnf,x,NULL,0,flag));
}

GEN
isprincipal(GEN bignf,GEN x)
{
  return isprincipalall(bignf,x,nf_REGULAR);
}

GEN
isprincipalgen(GEN bignf,GEN x)
{
  return isprincipalall(bignf,x,nf_GEN);
}

GEN
isprincipalforce(GEN bignf,GEN x)
{
  return isprincipalall(bignf,x,nf_FORCE);
}

GEN
isprincipalgenforce(GEN bignf,GEN x)
{
  return isprincipalall(bignf,x,nf_GEN | nf_FORCE);
}

#undef MAXITER

GEN
isunit(GEN bnf,GEN x)
{
  long av=avma,tetpil,tx = typ(x),i,R1,RU,nru;
  GEN RES,matunit,y,p1,p2,p3,nf,ro1,pisurw,pish;

  checkbnf(bnf); nf=(GEN)bnf[7];
  matunit=(GEN)bnf[3]; RU=lg(matunit);
  RES=(GEN)bnf[8]; ro1=(GEN)RES[4];
  nru=itos((GEN)ro1[1]);
  switch(tx)
  {
    case t_FRAC: case t_FRACN: return cgetg(1,t_COL);
    case t_INT:
      if (!is_pm1(x)) return cgetg(1,t_COL);
      y=cgetg(RU+1,t_COL); for (i=1; i<RU; i++) y[i]=zero;
      y[RU]=(signe(x)>0)? (long)gmodulss(0,nru)
                        : (long)gmodulss(nru>>1,nru);
      return y;
    
    case t_POLMOD:
      if (!gegal((GEN)nf[1],(GEN)x[1]))
        err(talker,"not the same number field in isunit");
      p1 = x; x = algtobasis(bnf,(GEN)x[2]); break;
    case t_POL:
      p1 = x; x = algtobasis(bnf,x); break;

    case t_COL:
      if (lg(nf[1])-2 == lg(x)) { p1 = basistoalg(nf,x); break; }

    default:
      err(talker,"not an algebraic number in isunit");
  }
  if (typ(p1)!=t_POLMOD) p1 = gmodulcp(p1,(GEN)nf[1]);
  if (!gcmp1(denom(x)) || !is_pm1(gnorm(p1)))
  { 
    avma=av; return cgetg(1,t_COL);
  }

  R1=itos(gmael(nf,2,1));
  p1=cgetg(RU+1,t_COL);
  for (i=1; i<=R1; i++) p1[i]=un;
  for (   ; i<=RU; i++) p1[i]=deux;
  p3=get_arch(nf,x,MEDDEFAULTPREC); settyp(p3,t_COL);
  p1=concatsp(matunit,p1); p2=ground(gauss(greal(p1),greal(p3)));
  if (!gcmp0((GEN)p2[RU]))
    err(talker,"insufficient precision in isunit");
  p1=gsub(p3,gmul(p1,p2)); pish=mppi(MEDDEFAULTPREC);
  pisurw = gdivgs(pish, nru>>1);
  if (!R1) pisurw=gmul2n(pisurw,1);
  p3=get_arch(nf,(GEN)ro1[2],MEDDEFAULTPREC);
  p3=gmodulcp(ground(gdiv(gimag((GEN)p3[1]),pisurw)),(GEN)ro1[1]);
  p1=gmodulcp(ground(gdiv(gimag((GEN)p1[1]),pisurw)),(GEN)ro1[1]);
  tetpil=avma; y=cgetg(RU+1,t_COL);
  for (i=1; i<RU; i++) y[i]=lcopy((GEN)p2[i]);
  y[RU]=ldiv(p1,p3); return gerepile(av,tetpil,y);
}

GEN
signunits(GEN bnf)
{
  long av,i,j,R1,RU,mun;
  GEN matunit,y,p1,p2,nf,pi;

  checkbnf(bnf); nf=checknf(bnf);
  matunit=(GEN)bnf[3]; RU=lg(matunit);
  R1=itos(gmael(nf,2,1)); pi=mppi(MEDDEFAULTPREC);
  y=cgetg(RU,t_MAT); mun = lnegi(gun);
  for (j=1; j<RU; j++)
  {
    p1=cgetg(R1+1,t_COL); y[j]=(long)p1; av=avma; 
    for (i=1; i<=R1; i++)
    {
      p2 = ground(gdiv(gimag(gcoeff(matunit,i,j)),pi));
      p1[i] = mpodd(p2)? mun: un;
    }
    avma=av;
  }
  return y;
}

static GEN
buchall_for_degree_one_pol(GEN P,long flun)
{
  GEN CHANGE,RES,z,p;
  long av,tetpil,i;

  av=avma;
  if (labs(flun)>1) RES=cgetg(11,t_VEC);
  else RES=flun? cgetg(9,t_VEC): cgetg(8,t_VEC);

  RES[1]=(long)P;
  p=cgetg(3,t_VEC); p[1]=un; p[2]=zero;
  RES[2]=(long)p;
  p=cgetg(3,t_VEC); p[1]=un; p[2]=un;
  RES[3]=(long)p;
  p=cgetg(2,t_VEC); p[1]=un;
  RES[4]=(long)p;

  p=cgetg(4,t_VEC); p[1]=un; p[2]=lgetg(1,t_VEC); p[3]=lgetg(1,t_VEC);
  RES[5]=(long)p;
  RES[6]=un;
  RES[7]=un;
  if (flun) { p=cgetg(3,t_VEC); RES[8]=(long)p; p[1]=deux; p[2]=lneg(gun); }
  if (labs(flun)>1) { RES[9]=lgetg(1,t_VEC); RES[10]=lstoi(EXP220); }
  if (flun>=0)
  {
    z=cgetg(2,t_MAT); z[1]=(long)RES; tetpil=avma;
    return gerepile(av,tetpil,gcopy(z));
  }

  z=cgetg(11,t_VEC);
  z[1]=lgetg(1,t_MAT); z[2]=lgetg(1,t_MAT);
  z[3]=lgetg(1,t_MAT); z[4]=lgetg(1,t_MAT);
  z[5]=lgetg(1,t_COL); z[6]=lgetg(1,t_VEC);
  p=initalg(P,MEDDEFAULTPREC);

  if (lg(p)!=3) CHANGE = NULL;
  else
  {
    CHANGE=(GEN)p[2]; /* P was a non-monic polynomial, nfinit changed it */
    p=(GEN)p[1];
  }
  z[7]=(long)p;

  i=(flun==-1)?4:6; p=cgetg(i+1,t_VEC);
  for ( ; i>=1; i--) p[i]=RES[i+4];
  z[8]=(long)p;
  p=cgetg(4,t_VEC);
  p[1]=lgetg(1,t_MAT); p[2]=lgetg(1,t_MAT); p[3]=lgetg(1,t_VEC);
  z[9]=(long)p;
  z[10]=zero;

  if (CHANGE)
  {
    RES=cgetg(3,t_VEC); RES[1]=(long)z; RES[2]=(long)CHANGE;
    z=RES;
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(z));
}

static GEN
quad_form(GEN *cbase,GEN ma,GEN ideal,long PRECREG)
{
  GEN p1 = qf_base_change(ma,ideal);

  *cbase=lllgram(p1,PRECREG);
  if (DEBUGLEVEL>6)
  {
    fprintferr(" matrice d'entree dans lllgram :\n"); outerr(p1);
    fprintferr(" matrice donnee par lllgram : PRECREG = %ld\n",PRECREG);
    outerr(*cbase);
  }
  p1 = qf_base_change(p1,*cbase);
  return sqred1(p1);
}

/* y is a vector of LONG, of length ly. x is a hx x ly matrix */
GEN
gmul_mat_smallvec(GEN x, GEN y, long hx, long ly)
{
  GEN z=cgetg(hx+1,t_COL), p1,p2;
  long i,j,av,tetpil;

  for (i=1; i<=hx; i++)
  {
    p1=gzero; av=avma;
    for (j=1; j<=ly; j++)
    {
      p2=gmulgs(gcoeff(x,i,j),y[j]);
      tetpil=avma; p1=gadd(p1,p2);
    }
    z[i]=lpile(av,tetpil,p1);
  }
  return z;
}

static double
get_minkovski(long PRECREG, long N, long R1, GEN D, GEN gborne)
{
  GEN p1,p2, pi = mppi(PRECREG);
  double bound;

  p1 = gsqrt(gmulsg(N,gmul2n(pi,1)),PRECREG);
  p1 = gdiv(p1, gexp(stoi(N),PRECREG));
  p1 = gmulsg(N, gpui(p1, dbltor(2./(double)N),PRECREG));
  p2 = gpui(gdivsg(4,pi), gdivgs(stoi(N-R1),N),PRECREG);
  p1 = gmul(p1,p2);
  bound = gtodouble(gmul(p1, gpui(absi(D), dbltor(1./(double)N),PRECREG)));
  bound = bound*gtodouble(gborne);
  if (DEBUGLEVEL)
  { 
    fprintferr("Borne pour les normes = %.0f\n",bound); flusherr();
  }
  return bound;
}

static long
small_norm_for_buchall(long t,long **mat,GEN matarch,long nbrel,long LIMC,
		       long N,GEN D,long RU,long R1,long PRECREG,GEN nf,
                       GEN gborne,long nbrelpid, GEN invp,long *L)
{
  long av=avma,av1,av2,av3,tetpil,limpile, *x,i,j,k,noideal,ran,keep_old_invp;
  long nbsmallnorm,nbsmallfact;
  double *y,*zz,**qq,*vv, MINKOVSKI_BOUND,IDEAL_BOUND,normideal,eps;
  GEN V,alpha,ma,ideal,rrr,cbase;

  if (gsigne(gborne)<=0) return t;
  if (DEBUGLEVEL)
  {
   fprintferr("\n#### Recherche des relations avec elements de petite norme\n");
   if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
   nbsmallnorm = nbsmallfact = 0; flusherr();
  }
  j=N+1; ma=gmael(nf,5,3);
  x=(long*)gpmalloc(j*sizeof(long));
  y=(double*)gpmalloc(j*sizeof(double));
  zz=(double*)gpmalloc(j*sizeof(double));
  vv=(double*)gpmalloc(j*sizeof(double));
  qq=(double**)gpmalloc(j*sizeof(double*));
  for (k=1; k<=N; k++) qq[k]=(double*)gpmalloc(j*sizeof(double));

  V=cgeti(KC+1); av1=avma;
  MINKOVSKI_BOUND = get_minkovski(PRECREG,N,R1,D,gborne);
  eps = 0.000001;
  for (noideal=1; noideal<=KC; noideal++)
  {
    long flbreak = 0, nbrelideal=0; 

    ideal=(GEN)vectbase[KC+1-noideal];
    if (DEBUGLEVEL>1)
    {
      fprintferr("\n*** Ideal no %ld : S = %ld , ",noideal,t);
      fprintferr("nombre premier = %ld , ",itos((GEN)ideal[1]));
      fprintferr("ideal = "); outerr(ideal);
    }
    normideal = gtodouble(gpui((GEN)ideal[1],(GEN)ideal[4],0));
    IDEAL_BOUND = MINKOVSKI_BOUND*pow(normideal,2./(double)N);
    ideal = prime_to_ideal(nf,ideal);
    rrr = quad_form(&cbase,ma,ideal,PRECREG);
    for (k=1; k<=N; k++)
    {
      vv[k]=gtodouble(gcoeff(rrr,k,k));
      for (j=1; j<k; j++) qq[j][k]=gtodouble(gcoeff(rrr,j,k));
      if (DEBUGLEVEL>3) fprintferr("vv[%ld]=%.0f ",k,vv[k]);
    }
    if (DEBUGLEVEL>1)
    { 
      if (DEBUGLEVEL>3) fprintferr("\n");
      fprintferr("IDEAL_BOUND  = %.0f\n",IDEAL_BOUND); flusherr();
    }
    IDEAL_BOUND += eps; av2=avma; limpile = (av2+bot)>>1;
    x[0]=k=N; y[N]=zz[N]=0; x[N]= (long) sqrt(IDEAL_BOUND/vv[N]);
    for(;; x[1]--)
    {
      for(;;) /* looking for primitive element of small norm */
      {
	double p;

	if (k>1)
	{
	  /* We need to define `l' for NeXTgcc 2.5.8 */
	  long l=k-1;
	  zz[l]=0;
	  for (j=k; j<=N; j++) zz[l] += qq[l][j]*x[j];
	  p=x[k]+zz[k];
	  y[l]=y[k]+p*p*vv[k];
	  x[l]=(long) floor(sqrt((IDEAL_BOUND-y[l])/vv[l])-zz[l]);
          k=l;
	}
	for(;;)
	{
	  p=x[k]+zz[k];
	  if (y[k] + vv[k]*p*p <= IDEAL_BOUND) break;
	  k++; x[k]--;
	}
	if (k==1) /* element complete */
	{
	  if (!x[1] && y[1]<=eps) { flbreak=1; break; }
	  if (ccontent(x)==1) /* primitive */
	  {
	    if (DEBUGLEVEL>4)
            { 
              fprintferr("** Found one element: AVMA = %ld\n",avma);
              flusherr();
            }
	    av3=avma; alpha=gmul(ideal,gmul_mat_smallvec(cbase,x,N,N));
	    j=N; while (j>=2 && !signe(alpha[j])) --j;
	    if (j!=1)
	    {
	      if (DEBUGLEVEL)
	      {
		if (DEBUGLEVEL>1)
		{
		  fprintferr(".");
		  if (DEBUGLEVEL>7)
		  {
		    GEN bq = gzero, cq;
		    outerr(gdiv(absi(subres(gmul((GEN)nf[7],alpha),(GEN)nf[1])),
				idealnorm(nf,ideal)));
		    for (j=1; j<=N; j++)
		    {
		      cq=gzero;
		      for (i=j+1; i<=N; i++)
			cq=gadd(cq,gmulgs(gcoeff(rrr,j,i),x[i]));
		      cq=gaddgs(cq,x[j]);
		      bq=gadd(bq,gmul(gsqr(cq),gcoeff(rrr,j,j)));
		    }
		    outerr(bq);
		  }
		}
		nbsmallnorm++; flusherr(); 
	      }
	      if (factorisealpha(nf,alpha,KCZ,LIMC)) break; /* can factor it */
	    }
	    avma=av3;
	  }
	  x[1]--;
	}
      }
      if (flbreak) { flbreak=0; break; }

      if (t && t<KC) /* matrix empty or maximal rank */
      { 
	for (i=1; i<=KC; i++) V[i]=0;
	for (i=1; i<=primfact[0]; i++) V[primfact[i]] = expoprimfact[i];
	keep_old_invp=0; ran=addcolumntomatrix(V,KC,t,&invp,L);
      }
      else { keep_old_invp=1; ran=t+1; }
      if (ran==t)
	{ if (DEBUGLEVEL>1) { fprintferr("*"); flusherr(); } }
      else
      {
	GEN p1, *newcol; /* record the new relation */

	t=ran; newcol=(GEN*)matarch[t];
	for (j=1; j<=primfact[0]; j++)
	  mat[t][primfact[j]] = expoprimfact[j];

	p1=gmul(gmael(nf,5,1),alpha);
	for (j=1; j<=R1; j++)
	  gaffect(glog((GEN)p1[j],PRECREG), newcol[j]);
	for (   ; j<=RU; j++)
	  gaffect(gmul2n(glog((GEN)p1[j],PRECREG),1), newcol[j]);

	if (DEBUGLEVEL)
	{
	  if (DEBUGLEVEL==1) fprintferr("%4ld",t);
	  else
	  {
	    fprintferr("t = %ld",t);
	    if (DEBUGLEVEL>2)
	    {
	      fprintferr("[");
	      for (j=1; j<=N; j++)
		{ fprintferr(" "); bruterr((GEN)(alpha[j]),'g',-1); }
	      fprintferr(" ]");
	    }
	    fprintferr("\n[");
	    for (j=1; j<=KC; j++) fprintferr("%4ld",mat[t][j]);
	    fprintferr("]\n");
	  }
	  flusherr(); nbsmallfact++;
	}
	if (t>=nbrel) { flbreak=1; break; }
	nbrelideal++; if (nbrelideal==nbrelpid) break;
      }
      if (keep_old_invp)
	avma=av3;
      else if (low_stack(limpile, (av2+bot)>>1))
      {
	if(DEBUGMEM>1) err(warnmem,"small_norm_for_buchall");
        tetpil=avma; invp=gerepile(av2,tetpil,gcopy(invp));
      }
      if (DEBUGLEVEL>4)
        { fprintferr("** Found one element: AVMA = %ld\n",avma); flusherr(); }
    }
    if (flbreak) break;
    tetpil=avma; invp=gerepile(av1,tetpil,gcopy(invp));
    if (DEBUGLEVEL>1) msgtimer("for this ideal");
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>1)
    {
      GEN p1,tmp=cgetg(t+1,t_MAT);

      fprintferr("\nLes elements de petite norme ont donne %ld relations.\n",t);
      fprintferr("\nCalcul du rang :"); flusherr();
      for(j=1;j<=t;j++)
      {
	p1=cgetg(KC+1,t_COL); tmp[j]=(long)p1;
	for(i=1;i<=KC;i++) p1[i]=lstoi(mat[j][i]);
      }
      tmp = (GEN)indexrank(tmp)[2]; k=lg(tmp)-1;
      fprintferr("rang = %ld; colonnes independantes :\n",k);
      for (i=1; i<=k; i++) fprintferr("%4ld",itos((GEN)tmp[i]));
      fprintferr("\n"); msgtimer("rank");
    }
    if(nbsmallnorm)
      fprintferr("\nnb. fact./nb. small norm = %ld/%ld = %f\n",
               nbsmallfact,nbsmallnorm,((double)nbsmallfact)/nbsmallnorm);
    else fprintferr("\nnb. fact./nb. small norm = 0/0\n");
    msgtimer("small norm relations");
  }
  for (j=1; j<=N; j++) free(qq[j]);
  free(qq); free(x); free(y); free(zz); free(vv);
  avma=av; return t;
}

static GEN
ideallllredpart1spec(GEN nf, GEN x, GEN matt2, long N, long prec)
{
  GEN p1,y,idealpro;
  long i;

  if (!gcmp1(gcoeff(x,N,N))) { p1=content(x); if (!gcmp1(p1)) x=gdiv(x,p1); }
  p1 = lllgram(qf_base_change(matt2,x),prec+1);

  y=gmul(x,(GEN)p1[1]);
  i=2; while (i<=N && gcmp0((GEN)y[i])) i++;
  if (i>N) y=gmul(x,(GEN)p1[2]);
  p1=subres(gmul((GEN)nf[7],y), (GEN)nf[1]);

  idealpro=cgetg(4,t_VEC);
  idealpro[1]=(long)x; idealpro[2]=(long)y; idealpro[3]=(long)gabs(p1,0);
  if (DEBUGLEVEL>5) { fprintferr("\nidealpro = "); outerr(idealpro); }
  return idealpro;
}

static GEN
ideallllredpart2(GEN nf, GEN arch, GEN gamma, long prec)
{
  long N=lgef(nf[1])-3,i,r1,r2,ru;
  GEN v,z;

  z=gmul(gmael(nf,5,1),gamma);
  r2=itos(gmael(nf,2,2)); ru=N-r2; r1=ru-r2;
  v=cgetg(ru+1,t_VEC);
  for (i=1; i<=r1; i++) v[i]=llog((GEN)z[i],prec);
  for (   ; i<=ru; i++) v[i]=lmul2n(glog((GEN)z[i],prec),1);
  for (i=1; i<=ru; i++) v[i]=lsub((GEN)arch[i],(GEN)v[i]);
  return v;
}

static void
dbg_newrel(long RU,long cmptglob,long iz,long jideal, long bouext,long bou,
             long phase, long *vperm, long *col, GEN colarch)
{
  long i;

  fprintferr("\n++++ cmptglob = %ld: nouvelle relation",cmptglob);
  if (DEBUGLEVEL>3)
  {
    fprintferr("(iz=%ld,",iz); 
    fprintferr("jideal=%ld,bouext=%ld,",jideal,bouext);
    fprintferr("bou=%ld,phase=%ld)",bou,phase);
  }
  fprintferr("\n[");
  for (i=1; i<=KC; i++)fprintferr("%4ld",col[i]);
  fprintferr("]\n");
  if (DEBUGLEVEL>3) msgtimer("for this relation");
  if (DEBUGLEVEL>6)
  {
    fprintferr("partie archimedienne =\n");
    for (i=1; i<=RU; i++) outerr((GEN)colarch[i]);
    for (i=1; i<=KC; i++)
      fprintferr("vperm[%ld]=%ld,",i,vperm[i]);
    fprintferr("\n");
    fprintferr("$$$$$ AVMA = %ld\n",avma);
  }
  flusherr() ;
}

static void
dbg_cancelrel(long i,long iz,long jideal,long bouext,long bou,long phase,
                 long *col)
{
  fprintferr("rel. elim. phase %ld: %ld ",phase,i);
  if (DEBUGLEVEL>3)
  {
    fprintferr("(iz=%ld,",iz);
    fprintferr("jideal=%ld,bouext=%ld,",jideal,bouext);
    fprintferr("bou=%ld,phase=%ld)",bou,phase);
    if (DEBUGLEVEL>6)
      fprintferr("$$$$$ AVMA = %ld\n",avma);
  }
  fprintferr("\n[");
  for (i=1; i<=KC; i++) fprintferr("%4ld",col[i]);
  fprintferr("]\n"); flusherr();
}

static void
dbg_outrel(long iz,long jideal,long bouext,long bou,long phase,long cmptglob,
	     long lim,long **ma,long *vperm,GEN maarch)
{
  long av,i,j;
  GEN p1,p2;
  
  if (phase == 0)
  {
    fprintferr("A la sortie : iz=%ld,jideal=%ld",iz,jideal);
    fprintferr("bouext=%ld,bou=%ld,phase=%ld\n",bouext,bou,phase);
    if (DEBUGLEVEL>3) fprintferr("***** AVMA = %ld\n",avma);
    av=avma; p2=cgetg(cmptglob+1,t_MAT);
    for (j=1; j<=cmptglob; j++)
    {
      p1=cgetg(KC+1,t_COL); p2[j]=(long)p1;
      for (i=1; i<=KC; i++) p1[i]=lstoi(ma[j][i]);
    }
    fprintferr("\nRang  = %ld, temps = %ld\n",rank(p2),timer2());
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    if (DEBUGLEVEL>3)
    {
      fprintferr("mat = \n");
      for (i=1; i<=KC; i++)
      {
	fprintferr("[");
	for (j=1; j <= lim; j++) fprintferr("%4ld",ma[j][i]);
	fprintferr("]\n");
      }
      fprintferr("\nmatarch = "); outerr(maarch);
    }
    avma=av;
  }
  else if (DEBUGLEVEL>6)
  {
    fprintferr("avant hnfadd :\nvectbase[vperm[]] = \n");
    fprintferr("[");
    for (i=1; i<=KC; i++)
    { 
      bruterr((GEN)vectbase[vperm[i]],'g',-1);
      if (i<KC) fprintferr(",");
    }
    fprintferr("]~\n");
  } 
  flusherr();
}

/* check if we already have a column mat[l] equal to mat[s] */
static long
already_found_relation_of_long(long **mat,long s)
{
  long l,bs,cl,*coll,*cols = mat[s];

  bs=1; while (bs<=KC && !cols[bs]) bs++;
  if (bs>KC) return s; /* zero relation */

#if 0 
  /* Could check for colinearity and replace by gcd. Useless in practice */
  cs=cols[bs];
  for (l=s-1; l; l--)
  {
    coll=mat[l]; cl=coll[0]; /* = index of first non zero elt in coll */
    if (cl==bs)
    {
      long b=bs;
      cl=coll[cl];
      do b++; while (b<=KC && cl*cols[b] == cs*coll[b]);
      if (b>KC) return l;
    }
  }
#endif
  for (l=s-1; l; l--)
  {
    coll=mat[l]; cl=coll[0]; /* = index of first non zero elt in coll */
    if (cl==bs)
    {
      long b=bs;
      do b++; while (b<=KC && cols[b] == coll[b]);
      if (b>KC) return l;
    }
  }
  cols[0]=bs; return 0;
}

/* if phase != 1 re-initialize static variables. If <0 return immediately */
static long
random_relation(long cmptglob,long lim,long LIMC,long N,long RU,long PRECREG,
		long PRECREGINT, GEN nf, long *vperm,long *subvperm,long **ma,
		GEN maarch,GEN lmatt2,long *ex,long phase)
{
  static long iz, jideal, bou, bouext;
  long i,pz,fl,av,cptzer,nbmatt2,nobreak;
  GEN ideal,idealpro,idealcourant,pgen1;

  if (phase != 1) { iz=jideal=bouext=1; if (phase<0) return 0; }
  nbmatt2 = lg(lmatt2)-1; cptzer = 0; av = avma;
  for(;;)
  {
    pz = factorbase[iz]; /* 1<= iz <= KCZ */
    idealcourant = idealbase[numfactorbase[pz]];
    if (phase != 1) jideal = 1;
    while (jideal < lg(idealcourant))
    {
      ideal = prime_to_ideal(nf,(GEN)idealcourant[jideal]);
      for (i=1; i<lgsub; i++)
      {
	ex[i] = mymyrand()>>randshift;
	if (ex[i])
	  ideal = idealmulh(nf,ideal,powsubfactorbase[i][ex[i]]);
      }
      /* If ex  = 0, try another */
      if (typ(ideal)==t_MAT) { avma=av; continue; }

      fl = ideal_is_zk((GEN)ideal[1],N);
      nobreak = 1; if (phase != 1) bouext = 1;
      for ( ; nobreak && bouext <= nbmatt2; bouext++)
      {
	if (phase != 1) bou = bouext; else { phase=2; bou++; }
	for ( ; nobreak; bou++)
	{
	  if (bou > nbmatt2)
	  {
	    if (fl) nobreak=0;
	    break;
	  }
	  if (DEBUGLEVEL>2)
	  {
	    fprintferr("iz=%ld,jideal=%ld,bouext=%ld,",iz,jideal,bouext);
	    fprintferr("bou=%ld,phase=%ld,rand=%ld\n",bou,phase,pari_randseed);
	    if (DEBUGLEVEL>3) fprintferr("$$$$$ AVMA = %ld\n",avma);
	    flusherr();
	  }
	  idealpro = ideallllredpart1spec(nf,(GEN)ideal[1],
					  gcoeff(lmatt2,bouext,bou), N,
					  PRECREGINT);
	  if (factorisegen(nf,idealpro,KCZ,LIMC))
	  {
	    GEN colarch;
	    long *col;
	    
	    cmptglob++; col = ma[cmptglob];
	    for (i=1; i<lgsub; i++) col[subvperm[i]] = -ex[i];
	    for (i=1; i<=primfact[0]; i++) col[primfact[i]] += expoprimfact[i];
	    col[numideal[pz]+jideal]--;

	    i = already_found_relation_of_long(ma,cmptglob);
	    if (i)
	    {
	      if (DEBUGLEVEL>1) dbg_cancelrel(i,iz,jideal,bouext,bou,phase,col);
	      cmptglob--; cptzer++; for (i=1; i<=KC; i++) col[i]=0;
	      if (cptzer>MAXRELSUP) { avma=av; return -1; }
	    }
	    else
	    {
	      pgen1 = ideallllredpart2(nf,(GEN)ideal[2],(GEN)idealpro[2],
	                               PRECREG);
	      cptzer=0; colarch = (GEN) maarch[cmptglob];
	      for (i=1; i<=RU; i++)
		gaffect((GEN)pgen1[i],(GEN)colarch[i]);
	      if (DEBUGLEVEL)
		dbg_newrel(RU,cmptglob,iz,jideal,bouext,bou,phase,vperm,
		           col,colarch);

	      if (cmptglob == lim)
	      {
		if (DEBUGLEVEL>2)
		  dbg_outrel(iz,jideal,bouext,bou,phase,cmptglob,lim,ma,
		             vperm,maarch);
		if (phase)
		{
		  bouext=1; bou=1; jideal++;
		  if (jideal >= lg(idealcourant))
		  {
		    jideal=1;
		    if (iz == KCZ) iz=1; else iz++;
		  }
		}
		avma=av; return cmptglob;
	      }
	      nobreak=0;
	    }
	  }
	  else if (DEBUGLEVEL>1) { fprintferr("."); flusherr(); }
	  if (fl) nobreak=0;
	}
      }
      jideal++; avma = av;
    }
    if (iz == KCZ) iz=1; else iz++;
  }
}

static GEN
compute_regulator(GEN xarch,long RU,long R1,long N,long sreg,long PRECREG,
                  GEN *ptsublambda)
{
  GEN vei,mdet,image_mdet,reg,sublambda,lambda,xreal;
  GEN *gptr[2];
  long i,j,av = avma;

  if (DEBUGLEVEL)
  {
    fprintferr("\n#### Calcul du regulateur\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  xreal=greal(xarch); vei=cgetg(RU+1,t_COL);
  for (i=1; i<=R1; i++) vei[i]=un;
  for (   ; i<=RU; i++) vei[i]=deux;
  mdet=cgetg(sreg+2,t_MAT); mdet[1]=(long)vei;
  for (j=2; j<=sreg+1; j++) mdet[j]=xreal[j-1];
  image_mdet=imagereel(mdet,PRECREG);
  if (DEBUGLEVEL) msgtimer("imagereel");

  /* check we have full rank for units */
  if (lg(image_mdet) != RU+1) { avma=av; return NULL; }
  reg=gdivgs(gabs(det2(image_mdet),PRECREG),N);
  if (DEBUGLEVEL) msgtimer("detreel");
  if (gexpo(reg)<=-4) { avma=av; return NULL; }

  lambda=gauss(image_mdet,xreal);
  sublambda=cgetg(sreg+1,t_MAT);
  for (i=1; i<=sreg; i++)
  {
    sublambda[i]=lgetg(RU,t_COL);
    for (j=1; j<RU; j++)
      coeff(sublambda,j,i) = coeff(lambda,j+1,i);
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    msgtimer("gauss & lambda");
  }
  *ptsublambda = sublambda;
  gptr[0]=ptsublambda; gptr[1]=&reg;
  gerepilemany(av,gptr,2); return reg;
}

/* sort u2 et l'inverse de u1 */
GEN
compute_class_number(GEN mit,GEN *met,GEN *u1,GEN *u2) 
{
  long ngen = lg(mit)-1;

  if (DEBUGLEVEL>=4)
  {
    fprintferr("\n#### Calcul du nombre de classes\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  if (ngen)
  {
    long av = avma, tetpil;
    GEN *gptr[4], clh = gun, u1u2 = smith2(mit), p1 = (GEN)u1u2[3];

    for ( ; ngen>=1; ngen--) clh=mulii(clh,gcoeff(p1,ngen,ngen));
    tetpil=avma;
    *u1= ginv((GEN)u1u2[1]);
    *u2=gcopy((GEN)u1u2[2]);
    *met=gcopy(p1); clh = icopy(clh);

    gptr[0]=met; gptr[1]=u1; gptr[2]=u2; gptr[3]=&clh;
    gerepilemanysp(av,tetpil,gptr,4);
    if (DEBUGLEVEL>=4)
    {
      if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
      msgtimer("smith/class group");
    }
    return clh;
  }
  *met=cgetg(1,t_MAT); *u1=cgetg(1,t_MAT); *u2=cgetg(1,t_MAT);
  return gun;
}

/* Z = 2*clh / z*zu[1] */
static GEN
compute_check(GEN sublambda, GEN Z, long PRECREG, GEN *parch, GEN *reg)
{
  long av = avma, av2, tetpil;
  GEN p1,c_1,den, R = *reg;

  if (DEBUGLEVEL)
  {
    fprintferr("\n#### Calcul du check\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  c_1 = gmul(R,Z);
  sublambda = bestappr(sublambda,c_1); den = denom(sublambda);
  if (gcmp(den,c_1) > 0) { avma=av; return NULL; }

  p1 = gmul(sublambda,den); tetpil=avma;
  *parch = lllint(p1);
  
  av2=avma; p1 = det(gmul(sublambda,*parch));
  p1 = gabs(gmul(*reg,p1),PRECREG); gaffect(p1,R); avma=av2;

  if (DEBUGLEVEL) msgtimer("bestappr/regulator");
  *parch = gerepile(av,tetpil,*parch); return gmul(R,Z);
}

static long
be_honest(GEN nf,long RU,long PRECREGINT)
{
  long av,ex,i,j,k,iz,nbtest, N = lgef(nf[1])-3;
  GEN exu=cgeti(RU+1), MCtw = cgetg(RU+1,t_MAT);
  GEN p1,p2,ideal,idealpro, MC = gmael(nf,5,2), M = gmael(nf,5,1);

  if (DEBUGLEVEL)
  {
    fprintferr("be honest for primes from %ld to %ld\n",
		factorbase[KCZ+1],factorbase[KCZ2]);
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  } 
  av=avma;
  for (iz=KCZ+1; iz<=KCZ2; iz++)
  {
    p1=idealbase[numfactorbase[factorbase[iz]]];
    if (DEBUGLEVEL>1) fprintferr("%ld ", factorbase[iz]);
    for (j=1; j<lg(p1); j++)
      for(nbtest=0;;)
      {
	ideal = prime_to_ideal(nf,(GEN)p1[j]);
	for (i=1; i<lgsub; i++)
	{
	  ex = mymyrand()>>randshift;
	  if (ex) ideal = idealmulh(nf,ideal,(GEN)powsubfactorbase[i][ex][1]);
	}
	for (k=1; k<=RU; k++)
	{
	  if (k==1)
            for (i=1; i<=RU; i++) exu[i]=mymyrand()>>randshift;
          else
	  { 
	    for (i=1; i<=RU; i++) exu[i]=0; exu[k]=10;
	  }
          for (i=1; i<=RU; i++)
            MCtw[i] = exu[i]? lmul2n((GEN)MC[i],exu[i]<<1): MC[i];
          p2 = greal(gmul(MCtw,M));
          idealpro = ideallllredpart1spec(nf,ideal,p2,N,PRECREGINT);
	  if (factorisegen(nf,idealpro,iz-1,factorbase[iz-1])) break;
	  nbtest++; if (nbtest==20) return 0;
	}
	avma=av; if (k <= RU) break;
      }
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>1) fprintferr("\n");
    msgtimer("be honest");
  }
  avma=av; return 1;
}

static GEN
class_group_generators(long PRECREG,long PRECREGINT,GEN nf,GEN met,GEN clh,
                       GEN u1,GEN u2,long *vperm)
{
  long i,j,c,lo,s, comul;
  GEN basecl,p1,p2,detp2,p2min,detp1,baseclorig;

  if (DEBUGLEVEL)
  {
    fprintferr("\n#### Calcul des generateurs du groupe des classes\n");
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    flusherr();
  }
  lo = lg(met)-1; c=0;
  for (i=1; i<=lo; i++)
    if (!gcmp1(gcoeff(met,i,i))) c++;
  basecl=cgetg(c+1,t_VEC); baseclorig=cgetg(c+1,t_VEC);
  if (DEBUGLEVEL) msgtimer("cleancol");
  for (j=1; j<=c; j++)
  {
    p1=gcoeff(u1,1,j);
    p2=idealpowred_prime(nf,(GEN)vectbase[vperm[1]],p1,PRECREG);
    if (signe(p1)<0) p2 = gmul(p2,denom(p2));
    for (i=2; i<=lo; i++)
    {
      p1=gcoeff(u1,i,j); s=signe(p1);
      if (s)
      {
	p1 = idealpowred_prime(nf,(GEN)vectbase[vperm[i]],p1,PRECREGINT);
        if (s<0) p1 = gmul(p1,denom(p1));
	p2 = idealmulh(nf,p2,p1);
	p2 = ideallllredall(nf,p2,gzero,PRECREGINT,PRECREGINT);
      }
    }
    baseclorig[j]=(long)p2; p2=(GEN)p2[1];
    detp2 = dethnf(p2); p1=idealinv(nf,p2); p1=gmul(p1,denom(p1)); 
    detp1 = dethnf(p1);
    if (gcmp(detp1,detp2)<0)
      { detp2=detp1; p2min=p1; comul=1; }
    else
      { p2min=p2; comul=0; }
    p1=ideallllredall(nf,p1,gzero,PRECREGINT,PRECREGINT);
    detp1 = dethnf(p1);
    if (gcmp(detp1,detp2)<0) 
      { detp2=detp1; p2min=p1; comul=1; }
    basecl[j]=(long)p2min;
    if (comul)
    { 
      u1[j]=lneg((GEN)u1[j]);
      u2[j]=lneg((GEN)u2[j]);
    }
  }
  p2=cgetg(c+1,t_VEC); for (i=1; i<=c; i++) p2[i]=coeff(met,i,i);
  p1=cgetg(7,t_VEC); p1[1]=(long)clh;
  p1[2]=(long)p2; p1[3]=(long)basecl;
  /* mit*u2 = u1*diag(cycliclist_i) */
  p1[4]=(long)u1; p1[5]=(long)u2; p1[6]=(long)baseclorig;
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    msgtimer("classgroup generators");
  }
  return p1;
}

static GEN
compute_matt2(long RU,GEN nf)
{
  long av = avma,tetpil,i,j,k,n = min(RU,9);
  GEN p1,p2,matt2, MCcopy, MCshif, M = gmael(nf,5,1), MC = gmael(nf,5,2);

  MCcopy=cgetg(RU+1,t_MAT); MCshif=cgetg(n+1,t_MAT);
  for (k=1; k<=RU; k++) MCcopy[k]=MC[k];
  for (k=1; k<=n; k++) MCshif[k]=lmul2n((GEN)MC[k],20);
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    fprintferr("compute weighted T2 matrices: "); flusherr();
  }
  matt2=cgetg(n+1,t_MAT);
  for (j=1; j<=n; j++)
  {
    p1=cgetg(n+1,t_COL); matt2[j]=(long)p1;
    MCcopy[j]=MCshif[j];
    for (i=1; i<=j; i++)
    {
      MCcopy[i]=MCshif[i];
      av=avma; p2=gmul(MCcopy,M); tetpil=avma;
      p1[i]=lpile(av,tetpil,greal(p2));
      MCcopy[i]=MC[i];
    }
    MCcopy[j]=MC[j];
    for (   ; i<=n; i++) p1[i]=zero;
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) fprintferr("$$$$$ AVMA = %ld\n",avma);
    msgtimer("weighted T2 matrices");
  }
  return matt2;
}

/* no garbage collecting. destroys y */
static
GEN relationrank_partial(GEN ptinvp, GEN y, long k, long n)
{
  long i,j;
  GEN res=cgetg(n+1,t_MAT), p1;

  for (i=k+1; i<=n; i++) y[i] = ldiv(gneg((GEN)y[i]),(GEN)y[k]);
  for (j=1; j<=k; j++)
  {
    p1=cgetg(n+1,t_COL); res[j]=(long)p1;
    for (i=1; i<j; i++) p1[i]=zero;
    for (   ; i<k; i++) p1[i]=coeff(ptinvp,i,j);
    p1[k]=ldiv(gcoeff(ptinvp,k,j),(GEN)y[k]);
    if (j==k)
      for (i=k+1; i<=n; i++)
	p1[i]=lmul((GEN)y[i],gcoeff(ptinvp,k,k));
    else
      for (i=k+1; i<=n; i++)
	p1[i]=ladd(gcoeff(ptinvp,i,j), gmul((GEN)y[i], gcoeff(ptinvp,k,j)));
  }
  for (  ; j<=n; j++) res[j]=ptinvp[j];
  return res;
}

/* Programmes de calcul du rang d'une matrice A de M_{ n,r }(Q) avec rang(A)=
 * r <= n On transforme peu a peu la matrice  I dont les colonnes sont les
 * vecteurs de la base canonique de Q^n en une matrice de changement de base
 * P obtenue en prenant comme base les colonnes de A independantes et des
 * vecteurs de la base canonique. On rend P^(-1), L un vecteur ligne a n
 * composantes valant 0 ou 1 selon que le le vecteur correspondant de P est
 * e_i ou x_i (e_i vecteur de la base canonique, x_i i-eme colonne de A)
 */
static GEN
relationrank(long **mat,long n,long r,long *L)
{
  long av = avma,tetpil,i,j,lim;
  GEN ptinvp,y;

  if (r>n) err(talker,"incorrect matrix in relationrank");
  if (DEBUGLEVEL)
  {
    fprintferr("Apres relations triviales, cmptglob = %ld\n",r);
    if (DEBUGLEVEL>4)
      fprintferr("\n** Initialisation du rang : AVMA = %ld\n",avma);
    msgtimer("mat & matarch");
  }
  lim=(av+bot)>>1; ptinvp=idmat(n);
  for (i=1; i<=r; i++)
  {
    j=1; y = gmul_mat_smallvec(ptinvp,mat[i],n,n);
    while (j<=n && (gcmp0((GEN)y[j]) || L[j])) j++;
    if (j>n && i==r) err(talker,"not a maximum rank matrix in relationrank");
    ptinvp = relationrank_partial(ptinvp,y,j,n); L[j]=1;
    if (low_stack(lim, (av+bot)>>1))
    { 
      if(DEBUGMEM>1) err(warnmem,"relationrank");
      tetpil=avma; ptinvp=gerepile(av,tetpil,gcopy(ptinvp));
    }
  }
  tetpil=avma; ptinvp=gerepile(av,tetpil,gcopy(ptinvp));
  if (DEBUGLEVEL>1)
  {
    fprintferr("\nRang de la matrice des relations triviales : %ld\n",r);
    if (DEBUGLEVEL>4)
      fprintferr("\n** Sortie de l'initialisation du rang : AVMA = %ld\n",avma);
    flusherr();
  }
  return ptinvp;
}

/* Etant donnes une matrice dans M_{ n,r }(Q), de rang maximum r < n, un
 * vecteur colonne V a n lignes, la matrice *INVP et le vecteur ligne *L
 * donnes par le programme relationrank() ci-dessus, on teste si le vecteur V
 * est lineairement independant des colonnes de la matrice; si la reponse est
 * non, on rend le rang de la matrice; si la reponse est oui, on rend le rang
 * de la matrice + 1, on met dans *INVP l'inverse de la nouvelle matrice
 * *INVP et dans *L le nouveau vecteur ligne *L
 */
long
addcolumntomatrix(long *V, long n,long r,GEN *INVP,long *L)
{
  long av = avma,i,k;
  GEN ptinvp,y;

  if (DEBUGLEVEL>4)
  { 
    fprintferr("\n*** entree ds addcolumntomatrix() : AVMA = %ld\n",avma);
    flusherr();
  }
  ptinvp=*INVP; y=gmul_mat_smallvec(ptinvp,V,n,n);
  if (DEBUGLEVEL>6)
  {
    fprintferr("vecteur = [\n"); 
    for (i=1; i<=n-1; i++) fprintferr("%ld,",V[i]);
    fprintferr("%ld]~\n",V[n]); flusherr();
    fprintferr("vecteur ds new base = \n"); outerr(y);
    fprintferr("matrice de passage = \n"); outerr(ptinvp);
    fprintferr("liste = [");
    for (i=1; i<=n-1; i++) fprintferr("%ld,",L[i]);
    fprintferr("%ld]\n",L[n]); flusherr();
  }
  k=1; while (k<=n && (gcmp0((GEN)y[k]) || L[k])) k++;
  if (k>n) avma=av;
  else
  {
    *INVP = relationrank_partial(ptinvp,y,k,n);
    L[k]=1; r++;
  }
  if (DEBUGLEVEL>4)
  { 
    fprintferr("*** sortie de addcolumntomatrix() : AVMA = %ld\n",avma);
    flusherr();
  }
  return r;
}

/* a usage special: uniquement pour passer du format smallbnf au format bnf
 * Ici, vectbase est deja permute, donc pas de vperm. A l'effet de
 * compute_class_number() suivi de class_group_generators().
 */
static GEN
classintern(GEN nf,GEN mit)
{
  long av=avma,tetpil,i,lv;
  long PREC = gprecision((GEN)nf[6]);
  GEN met,u1,u2,vperm, clh=compute_class_number(mit,&met,&u1,&u2);

  lv=lg(vectbase); vperm=cgetg(lv,t_VEC);
  for (i=1; i<lv; i++) vperm[i]=i;
  clh = class_group_generators(PREC,PREC,nf,met,clh,u1,u2,vperm);
  tetpil=avma; return gerepile(av,tetpil,gcopy(clh));
}

static GEN
codeprime(GEN bnf, GEN pr)
{
  long j,av=avma,tetpil;
  GEN p,al,fa,p1;

  p=(GEN)pr[1]; al=(GEN)pr[2]; fa=primedec(bnf,p);
  for (j=1; j<lg(fa); j++)
    if (gegal(al,gmael(fa,j,2)))
    { 
      p1=mulsi(lg(al)-1,p); tetpil=avma;
      return gerepile(av,tetpil,addsi(j-1,p1));
    }
  err(talker,"bug in codeprime/smallbuchinit");
  return NULL; /* not reached */
}

static GEN
decodeprime(GEN nf, GEN co)
{
  long n,indi,av=avma,tetpil;
  GEN p,rem,p1;

  n=lg(nf[7])-1; p=dvmdis(co,n,&rem); indi=itos(rem)+1;
  p1=primedec(nf,p); tetpil=avma;
  return gerepile(av,tetpil,gcopy((GEN)p1[indi]));
}

static GEN
makematal(GEN bnf)
{
  GEN mit,matalpha,pfb,vp,nf,ma,pr,id;
  long lm,lma,av=avma,tetpil,j,k;

  mit=(GEN)bnf[1]; matalpha=(GEN)bnf[2];
  pfb=(GEN)bnf[5]; vp=(GEN)bnf[6]; nf=(GEN)bnf[7];
  lm=(lg(mit)>1)?lg(mit[1])-1:0; lma=lm+lg(matalpha);
  ma=cgetg(lma,t_MAT);
  for (j=1; j<lma; j++)
  {
    id=(j<=lm)?gun:(GEN)pfb[itos((GEN)vp[j])];
    for (k=1; k<=lm; k++)
    {
      pr=(GEN)pfb[itos((GEN)vp[k])];
      id=idealmul(nf,id,idealpow(nf,pr,(j<=lm)?gcoeff(mit,k,j):gcoeff(matalpha,k,j-lm)));
    }
    ma[j]=isprincipalgen(bnf,id)[2];
    if (lg(ma[j])==1)
      err(talker,"bnf not accurate enough to create the sbnf (makematal)");
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(ma));
}
			
GEN
smallbuchinit(GEN pol,GEN gcbach,GEN gcbach2,GEN gRELSUP,GEN gborne,long nbrelpid,long minsfb,long prec)
{
  long av=avma,tetpil,k;
  GEN y,bnf,pfb,vp,nf,mas,res,uni,v1,v2,v3;

  if (typ(pol)==t_VEC) { checkbnf(pol); bnf=pol; }
  else bnf=buchall(pol,gcbach,gcbach2,gRELSUP,gborne,nbrelpid,minsfb,-3,prec);
  pfb=(GEN)bnf[5]; vp=(GEN)bnf[6]; nf=(GEN)bnf[7];
  mas=(GEN)nf[5]; res=(GEN)bnf[8]; uni=(GEN)res[5];

  tetpil=avma;
  y=cgetg(13,t_VEC); y[1]=lcopy((GEN)nf[1]); y[2]=lcopy(gmael(nf,2,1));
  y[3]=lcopy((GEN)nf[3]); y[4]=lcopy((GEN)nf[7]);
  y[5]=lcopy((GEN)nf[6]); y[6]=lcopy((GEN)mas[5]);
  y[7]=lcopy((GEN)bnf[1]); y[8]=lcopy((GEN)bnf[2]);
  v1=cgetg(lg(pfb),t_VEC); y[9]=(long)v1;
  for (k=1; k<lg(pfb); k++)
    v1[k]=(long)codeprime(bnf,(GEN)pfb[itos((GEN)vp[k])]);
  v2=cgetg(3,t_VEC); y[10]=(long)v2;
  v2[1]=lcopy(gmael(res,4,1));
  v2[2]=(long)algtobasis(bnf,gmael(res,4,2));
  v3=cgetg(lg(uni),t_VEC); y[11]=(long)v3;
  for (k=1; k<lg(uni); k++)
    v3[k]=(long)algtobasis(bnf,(GEN)uni[k]);
  y[12]=(long)makematal(bnf);
  return gerepile(av,tetpil,y);
}

static GEN
get_regulator(GEN mun,long prec)
{
  long av,tetpil;
  GEN p1;

  if (lg(mun[1])==1) return gun;
  av=avma; p1 = gtrans(greal(mun));
  setlg(p1,lg(p1)-1); p1 = det(p1);
  tetpil=avma; return gerepile(av,tetpil,gabs(p1,prec));
}

static GEN
get_mun(GEN funits, GEN ro, long ru, long r1, long prec)
{
  long j,k,av=avma,tetpil;
  GEN p1,p2, mun = cgetg(ru,t_MAT);

  for (k=1; k<ru; k++)
  {
    p1=cgetg(ru+1,t_COL); mun[k]=(long)p1;
    for (j=1; j<=ru; j++)
    {
      p2 = glog(poleval((GEN)funits[k],(GEN)ro[j]),prec);
      p1[j]=(j<=r1)? (long)p2: lmul2n(p2,1);
    }
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(mun));
}

#if 0
static GEN
get_mc()
{
}

GEN
bnfnewprec(GEN bnf, long prec)
{
  long r1,r2,ru;
  GEN nf,ro,res,p1,y,funits,mun;

  checkbnf(bnf); nf = nfnewprec((GEN)bnf[7],prec);
  r1=itos(gmael(nf,2,1)); r2=itos(gmael(nf,2,2)); 
  ru = r1+r2;

  y = cgetg(11,t_VEC);
  res=cgetg(7,t_VEC); p1=(GEN)bnf[8];
  res[1]=lcopy((GEN)p1[1]);
  res[2]=lcopy((GEN)p1[2]);
  funits=(GEN)p1[4]; ro=(GEN)nf[6];
  mun = get_mun(funits,ro,ru,r1,prec);
  res[3]=(long)get_regulator(mun,prec);
  res[4]=lcopy((GEN)p1[4]);
  res[5]=lcopy((GEN)p1[5]);
  res[6]=lcopy((GEN)p1[6]);

  y[1]=lcopy((GEN)bnf[1]);
  y[2]=lcopy((GEN)bnf[2]);
  y[3]=(long)mun;
  y[4]=(long)get_mc();
  y[5]=lcopy((GEN)bnf[5]);
  y[6]=lcopy((GEN)bnf[6]);
  y[7]=(long)nf;
  y[8]=(long)res;
  y[9]=lcopy((GEN)bnf[9]);
  y[10]=zero;
  return y;
}
#endif

GEN
bnfmake(GEN sbnf, long prec)
{
  long av = avma, tetpil,j,k,n,r1,r2,la,ru,lpf;
  GEN p1,p2,pol,bas,ro,m,mul,pok,M,MC,T2,mas,T,TI,nf,mun,funits;
  GEN pfc,vp,alphs,mc,clgp,cl,res,y,mit,mata,racu,reg;

  if (typ(sbnf)!=t_VEC || lg(sbnf)!=13)
    err(talker,"incorrect sbnf in bnfmake");
  pol=(GEN)sbnf[1]; bas=(GEN)sbnf[4]; n=lg(bas)-1; 
  r1=itos((GEN)sbnf[2]); r2=(n-r1)/2; ru=r1+r2; 
  ro=(GEN)sbnf[5];
  if (prec > gprecision(ro)) ro=get_roots(pol,r1,ru,prec);

  m=cgetg(n+1,t_MAT);
  for (k=1; k<=n; k++)
  {
    p1=cgetg(n+1,t_COL); m[k]=(long)p1; p2=(GEN)bas[k];
    for (j=1; j<=n; j++) p1[j]=(long)truecoeff(p2,j-1);
  }
  m=invmat(m);
  mul=cgetg(n*n+1,t_MAT);
  for (k=1; k<=n*n; k++)
  {
    pok = gres(gmul((GEN)bas[(k-1)%n+1], (GEN)bas[(long)((k-1)/n)+1]), pol);
    p1=cgetg(n+1,t_COL); mul[k]=(long)p1;
    for (j=1; j<=n; j++) p1[j]=(long)truecoeff(pok,j-1);
  }
  mul=gmul(m,mul);

  M  = make_M(n,ru,varn(pol),bas,ro);
  MC = make_MC(n,r1,ru,M);
  T2 = greal(gmul(MC,M));
  p1=greal(gmul(gconj(MC),M)); T=ground(p1);
  if (gexpo(gnorml2(gsub(p1,T))) > -30)
    err(talker,"insufficient precision in makebignf");
  TI=gmul((GEN)sbnf[3],invmat(T));

  mas=cgetg(8,t_VEC);
  mas[1]=(long)M; mas[2]=(long)MC; mas[3]=(long)T2;
  mas[4]=(long)T; mas[5]=sbnf[6];  mas[6]=(long)TI;
  mas[7]=(long)hnfmod(TI,detint(TI));

  nf=cgetg(10,t_VEC);
  p1=cgetg(3,t_VEC); p1[1]=lstoi(r1); p1[2]=lstoi(r2);
  nf[1]=sbnf[1]  ; nf[2]=(long)p1;  nf[3]=sbnf[3];
  nf[4]=ldet(m)  ; nf[5]=(long)mas; nf[6]=(long)ro;
  nf[7]=(long)bas; nf[8]=(long)m; nf[9]=(long)mul;

  funits=cgetg(ru,t_VEC);
  for (k=1; k<ru; k++)
    funits[k]=lmul(bas,gmael(sbnf,11,k));
  mun = get_mun(funits,ro,ru,r1,prec);

  prec=gprecision(ro); if (prec<DEFAULTPREC) prec=DEFAULTPREC;
  alphs=(GEN)sbnf[12]; la=lg(alphs); mc=cgetg(la,t_MAT);
  for (k=1; k<la; k++)
  {
    GEN p3, p4 = gmul(bas,(GEN)alphs[k]);

    p3 = gdivgs(glog(gabs(gnorm( gmodulcp(p4,pol) ),prec),prec), n);
    p1 = cgetg(ru+1,t_COL); mc[k] = (long)p1;
    for (j=1; j<=ru; j++)
    {
      p2 = gsub(glog(poleval(p4,(GEN)ro[j]),prec), p3);
      p1[j]=(j<=r1)? (long) p2: lmul2n(p2,1);
    }
  }

  pfc=(GEN)sbnf[9]; lpf=lg(pfc);
  vectbase=cgetg(lpf,t_COL); vp=cgetg(lpf,t_COL);
  for (j=1; j<lpf; j++)
  {
    vp[j]=lstoi(j);
    vectbase[j]=(long)decodeprime(nf,(GEN)pfc[j]);
  }
  cl=classintern(nf,(GEN)sbnf[7]); /* uses vectbase */
  clgp=cgetg(4,t_VEC); clgp[1]=cl[1]; clgp[2]=cl[2]; clgp[3]=cl[3];

  reg = get_regulator(mun,prec);
  p1=cgetg(3,t_VEC); racu=(GEN)sbnf[10];
  p1[1]=racu[1]; p1[2]=lmul(bas,(GEN)racu[2]);
  racu=p1;

  res=cgetg(7,t_VEC);
  res[1]=(long)clgp; res[2]=(long)reg;     res[3]=(long)dbltor(1.0);
  res[4]=(long)racu; res[5]=(long)funits;  res[6]=lstoi(1000);

  if (lg(sbnf[7])>1) { mit=(GEN)sbnf[7]; mata=(GEN)sbnf[8]; }
  else
  { 
    mit=cgetg(1,t_MAT); mata=cgetg(la,t_MAT);
    for (k=1; k<la; k++) mata[k]=lgetg(1,t_COL);
  }
  tetpil=avma; y=cgetg(11,t_VEC); p1=cgetg(4,t_VEC);
  p1[1]=lcopy((GEN)cl[4]); p1[2]=lcopy((GEN)cl[5]); p1[3]=lcopy((GEN)cl[6]);

  y[1]=lcopy(mit); y[2]=lcopy(mata);     y[3]=lcopy(mun);
  y[4]=lcopy(mc);  y[5]=lcopy(vectbase); y[6]=lcopy(vp);
  y[7]=lcopy(nf);  y[8]=lcopy(res);      y[9]=(long)p1;
  y[10]=zero;
  return gerepile(av,tetpil,y);
}

static GEN
classgroupall(GEN P, GEN data, long flag, long flall, long prec)
{
  long lx,nbrelpid,minsfb,flun,av;
  GEN gcbach,gcbach2,gRELSUP,gborne;
  long court[3],doubl[4];

  if (!data) lx=1;
  else 
  {
    if (typ(data)!=t_VEC) err(talker,"incorrect parameters in classgroup");
    lx = lg(data);
  }
  court[0]=evaltyp(t_INT) | evallg(3);
  doubl[0]=evaltyp(t_REAL)| evallg(4);
  affsi(5,court); av=avma; affrr(dbltor(0.3),doubl); avma=av;
  gcbach  = (lx>1)? (GEN)data[1]:doubl;
  gcbach2 = (lx>2)? (GEN)data[2]:doubl;
  gRELSUP = (lx>3)? (GEN)data[3]:court;
  gborne  = (lx>4)? (GEN)data[4]:gun;
  nbrelpid= (lx>5)? itos((GEN)data[5]):4;
  minsfb  = (lx>6)? itos((GEN)data[6]):3;
  if (!flall) flag+=4;
  switch(flag)
  {
    case 0: flun=-2; break;
    case 1: flun=-3; break;
    case 2: flun=-1; break;
    case 3: 
     return smallbuchinit(P,gcbach,gcbach2,gRELSUP,gborne,nbrelpid,minsfb,prec);
    case 4: flun=2; break;
    case 5: flun=3; break;
    case 6: flun=0; break;
    default: err(flagerr);
  }
  return buchall(P,gcbach,gcbach2,gRELSUP,gborne,nbrelpid,minsfb,flun,prec);
}

GEN
bnfclassunit0(GEN P, long flag, GEN data, long prec)
{
  if (typ(P)==t_INT) return quadclassunit0(P,0,data,prec);
  return classgroupall(P,data,flag,0,prec);
}

GEN
bnfinit0(GEN P, long flag, GEN data, long prec)
{
#if 0
  THIS SHOULD BE DONE...

  if (typ(P)==t_INT)
  {
    if (flag<4) err(impl,"specific bnfinit for quadratic fields");
    return quadclassunit0(P,0,data,prec);
  }
#endif
  return classgroupall(P,data,flag,1,prec);
}

GEN
classgrouponly(GEN P, GEN data, long prec)
{
  GEN y,z;
  long av=avma,tetpil,i;

  if (typ(P)==t_INT)
  {
    z=quadclassunit0(P,0,data,prec); tetpil=avma;
    y=cgetg(4,t_VEC); for (i=1; i<=3; i++) y[i]=lcopy((GEN)z[i]);
    return gerepile(av,tetpil,y);
  }
  z=(GEN)classgroupall(P,data,2,0,prec)[1]; tetpil=avma;
  return gerepile(av,tetpil,gcopy((GEN)z[5]));
}

GEN
regulator(GEN P, GEN data, long prec)
{
  GEN z;
  long av=avma,tetpil;

  if (typ(P)==t_INT)
  {
    if (signe(P)>0)
    {
      z=quadclassunit0(P,0,data,prec); tetpil=avma;
      return gerepile(av,tetpil,gcopy((GEN)z[4]));
    }
    return gun;
  }
  z=(GEN)classgroupall(P,data,2,0,prec)[1]; tetpil=avma;
  return gerepile(av,tetpil,gcopy((GEN)z[6]));
}
