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

/* See buch2.c:
 * precision en digits decimaux=2*(#digits decimaux de Disc)+50
 * on prendra les p decomposes tels que prod(p)>lim dans la subbase
 * LIMC=Max(c.(log(Disc))^2,exp((1/8).sqrt(log(Disc).loglog(Disc))))
 * LIMC2=Max(6.(log(Disc))^2,exp((1/8).sqrt(log(Disc).loglog(Disc))))
 * subbase contient les p decomposes tels que prod(p)>sqrt(Disc)
 * lgsub=subbase[0]=#subbase;
 * subfactorbase est la table des form[p] pour p dans subbase
 * nbram est le nombre de p divisant Disc elimines dans subbase
 * powsubfactorbase est la table des puissances des formes dans subfactorbase
 */
#define HASHT 1024
static const long CBUCH = 15; /* of the form 2^k-1 */
static const long randshift=BITS_IN_RANDOM-1 - 4; /* BITS_IN_RANDOM-1-k */

static long sens,KC,KC2,lgsub,limhash,RELSUP,PRECREG;
static long *primfact,*primfact1, *exprimfact,*exprimfact1, *badprim, *vperm;
static long *factorbase,*numfactorbase, *subbase, *vectbase, **hashtab;
static GEN  **powsubfactorbase, subfactorbase,Disc,sqrtD,isqrtD;

GEN buchquad(GEN D, double c, double c2, long RELSUP0, long flag, long prec);

GEN
quadclassunit0(GEN x, long flag, GEN data, long prec)
{
  long lx,RELSUP0;
  double cbach, cbach2;

  if (!data) lx=1;
  else
  {
    if (typ(data)!=t_VEC)
      err(talker,"incorrect parameters in quadclassunit");
    lx = lg(data);
  }
  cbach = cbach2 = 0.1; RELSUP0 = 5;
  switch(lx)
  {
    case 4: RELSUP0 = itos((GEN)data[3]);
    case 3: cbach2 = gtodouble((GEN)data[2]);
    case 2: cbach  = gtodouble((GEN)data[1]);
  }
  return buchquad(x,cbach,cbach2,RELSUP0,flag,prec);
}

/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*                 Corps de classe de Hilbert avec unites          */
/*                               de Stark                          */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/

static GEN
getmodule(GEN bnf, long prec)
{
  long i,j,jj,k,n,av=avma,av1,tetpil,h,b,j1,l,clhss,lengthli,limin,cpt=0;
  GEN li,cl,module,ideal,arch,sous,clm,bnr,cyc,gen,H,bnr2,y;

  lengthli=50; limin=2;
  cl=gmael3(bnf,8,1,1);
  LABELLI:
  arch=cgetg(3,t_VEC); arch[1]=un; arch[2]=zero;
  li=ideallist(bnf,lengthli);
  module=cgetg(3,t_VEC); module[2]=(long)arch; av1=avma;
  for(i=limin; i<=lengthli; i++)
  {
    if (DEBUGLEVEL>=2) fprintferr(" %ld",i);
    sous=(GEN)li[i];
    for(j=1; j<lg(sous); j++)
    {
      avma=av1;
      ideal=(GEN)sous[j]; module[1]=(long)ideal;
      clm=rayclassno(bnf,module);
      if (!mpodd(divii(clm,cl)))
      {
	bnr=buchrayinitgen(bnf,module,prec);
	cyc=gmael(bnr,5,2); gen=gmael(bnr,5,3); n=lg(cyc)-1;
	for(h=1; h<=n && !mpodd((GEN)cyc[h]); h++);
	h--; H=idmat(n);
	for(k=1; k<=h; k++)
	{
	  coeff(H,k,k)=deux; b=1<<(h-k);
	  for(jj=0; jj<b; jj++)
	  {
	    j1=jj;
	    for(l=k+1; l<=h; l++)
	    {
	      coeff(H,k,l)=(j1%2) ? un : zero;
	      j1>>=1;
	    }
	    bnr2=buchrayinit(bnf,ideal,prec);
	    clhss=cardofimagofquotientgroup(gen,bnr2,H);
	    if (clhss>2) err(bugparier,"getmodule");
            if (clhss==1)
            {
              tetpil=avma; y=cgetg(3,t_VEC);
              y[1]=lcopy(bnr);
              y[2]=lcopy(H); return gerepile(av,tetpil,y);
            }
	  }
          coeff(H,k,k)=un;
          for(l=k+1; l<=h; l++) coeff(H,k,l)=zero;
	}
      }
    }
  }
  cpt++;
  if (cpt<=5)
  {
    limin=lengthli+1; lengthli<<=1;
    avma=av; goto LABELLI;
  }
  else
  {
    err(talker,"module list not long enough in getmodule");
    return NULL; /* not reached */
  }
}

static GEN
getallchars(GEN bnf)
{
  long i,cl,n,j,i1,dj;
  GEN p1,y,clgp,cyc;

  clgp=gmael(bnf,8,1); cl=itos((GEN)clgp[1]); cyc=(GEN)clgp[2];
  n=lg(cyc)-1; y=cgetg(cl+1,t_VEC);
  for(i=0; i<cl; i++)
  {
    p1=cgetg(n+1,t_VEC); y[i+1]=(long)p1;
    i1=i;
    for(j=n; j; j--)
    {
      dj=itos((GEN)cyc[j]);
      p1[j]=lstoi(i1%dj);
      i1/=dj;
    }
  }
  return y;
}

static GEN
chiideal(GEN clgp, GEN listchar, GEN logideal, long flag, long prec)
{
  long av=avma,tetpil,cl,n,i,j;
  GEN cyc,d1,y,z,chi,p1,p2;

  cl=lg(listchar)-1; cyc=(GEN)clgp[2]; d1=(GEN)cyc[1];
  n=lg(cyc)-1; y=cgetg(cl+1,t_VEC);
  if (flag) z=gmodulcp(polx[0],cyclo(itos(d1),0));
  else
  {
    p1=cgetg(3,t_COMPLEX); p1[1]=zero;
    p1[2]=lmul2n(mppi(prec+1),1);
    z=gexp(gdiv(p1,d1),prec);
  }
  for(i=1; i<=cl; i++)
  {
    chi=(GEN)listchar[i];
    p1=gzero;
    for(j=1; j<=n; j++)
    {
      p2 = mulii((GEN)chi[j],(GEN)logideal[j]);
      p1 = addii(p1, mulii(p2,divii(d1,(GEN)cyc[j])));
    }
    y[i]=lpui(z,modii(p1,d1),prec);
  }
  tetpil=avma; return gerepile(av,tetpil,gcopy(y));
}

static GEN  
computean(GEN bnr, GEN subgroup, GEN listchar, long nmax, long prec)
{
  long ngenray,i,j,cl,q,cp,al,v1,v2,v,tetpil,av=avma,fldiv,av1,lim;
  long chi0,chi01,chi02,flag;
  GEN bnf,clgp,bid,rayclass,module,ideal,dk,genray,pass,idno,matan,p1;
  GEN prime,chi,qg,chi1,chi2,chi11,chi12;
  GEN pr,pr1,pr2,xray,xray1,xray2,xcl,z,invz,polz,d1;
  byteptr dp = diffptr;
  
  bnf=(GEN)bnr[1]; clgp=gmael(bnf,8,1); bid=(GEN)bnr[2];
  rayclass=(GEN)bnr[5];
  d1=gmael(clgp,2,1);
  flag=((prec>15)||(gegal(d1,gdeux)));  
  module=(GEN)bid[1]; ideal=(GEN)module[1]; dk=gmael(bnf,7,3);
  genray=(GEN)rayclass[3]; ngenray=lg(genray)-1;
  pass=cgetg(ngenray+1,t_MAT);
  for(j=1; j<=ngenray; j++) pass[j]=(long)isprincipal(bnf,(GEN)genray[j]);
  idno=idealnorm(bnf,ideal); 
  cl=lg(listchar)-1;
  if (flag)
  {
    polz=cyclo(itos(d1),0);
    invz=gmod(gpui(polx[0],gsubgs(d1,1),0),polz);
  }
  matan=cgetg(cl+1,t_MAT);
  for(j=1; j<=cl; j++)
  {
    p1=cgetg(nmax+1,t_COL); matan[j]=(long)p1;
    for(i=1; i<=nmax; i++) p1[i]=un;
  }
  prime=stoi(2); dp++;
  av1=avma; lim=(av1+3*bot)>>2;
  while (*dp && prime[2]<=nmax)
  {
    if (low_stack(lim, (av1+3*bot)>>2))
    {
      if(DEBUGMEM>1) err(warnmem,"computean");      
      tetpil=avma; matan=gerepile(av1,tetpil,gcopy(matan));
    }
    qg=prime; al=1;
    switch (krogs(dk,prime[2]))
    {
      case -1:
	fldiv=divise(idno,prime);
	if (!fldiv)
        {
          p1 = gauss(subgroup,isprincipalray(bnr,prime));
	  chi0 = !gcmp1(denom(p1));
        }
	while(cmpis(qg,nmax)<=0)
	{
	  q=qg[2];
	  for(cp=1,i=q; i<=nmax; i+=q,cp++)
	    if(cp%prime[2])
	    {
	      if (fldiv || al%2)
                for(j=1; j<=cl; j++) coeff(matan,i,j)=zero;
	      else
	      {
		if (al%4==2 && chi0)
                  for(j=1; j<=cl; j++) 
                    coeff(matan,i,j)=lneg(gcoeff(matan,i,j));
	      }
	    }
	  qg=mulii(qg,prime); al++;
 	}
	break;
      case 0:
	fldiv=divise(idno,prime);
	if (!fldiv)
	{
 	  pr=(GEN)primedec(bnf,prime)[1];
	  xray=isprincipalray(bnr,pr);
	  xcl=gmul(pass,xray);
	  chi0=!gcmp1(denom(gauss(subgroup,xray)));
	  if (flag) chi1=chiideal(clgp,listchar,xcl,flag,prec);
	  else
	    chi1=ground(greal(chiideal(clgp,listchar,xcl,flag,prec)));
	  if (chi0) chi1=gneg(chi1);
	}
	while(cmpis(qg,nmax)<=0)
	{
	  q=qg[2];
	  if (fldiv || al%2)
	    for(cp=1,i=q; i<=nmax; i+=q,cp++)
	      if(cp%prime[2])
	      {
		if (fldiv)
                  for(j=1; j<=cl; j++) coeff(matan,i,j)=zero;
		else
		{
		  for(j=1; j<=cl; j++)
		    coeff(matan,i,j)=lmul(gcoeff(matan,i,j),(GEN)chi1[j]);
		}
	      }
	  qg=mulii(qg,prime); al++;
	}
	break;
      case 1:
	p1=primedec(bnf,prime);
        pr1=(GEN)p1[1]; v1=idealval(bnf,ideal,pr1);
        pr2=(GEN)p1[2]; v2=idealval(bnf,ideal,pr2);
	if (v1+v2==0)
	{
	  xray1=isprincipalray(bnr,pr1);
	  chi01=!gcmp1(denom(gauss(subgroup,xray1)));
	  xray2=isprincipalray(bnr,pr2);
	  chi02=!gcmp1(denom(gauss(subgroup,xray2)));

	  xcl=gmul(pass,xray1);
	  chi11=chiideal(clgp,listchar,xcl,flag,prec);
	  if (flag)
	    chi12=gmodulcp(gsubst(lift(chi11),0,invz),polz);
	  else	    
	    chi12=gconj(chi11);
	  if (chi01) chi11=gneg(chi11);
	  if (chi02) chi12=gneg(chi12);
	  chi1=gadd(chi11,chi12); chi2=gcopy(chi12);
	  while(cmpis(qg,nmax)<=0)
	  {
	    q=qg[2];
	    for(cp=1,i=q; i<=nmax; i+=q,cp++)
	      if(cp%prime[2])
		for(j=1; j<=cl; j++)
		  coeff(matan,i,j)=lmul((GEN)chi1[j],gcoeff(matan,i,j));

	    qg=mulii(qg,prime); al++;
	    if(cmpis(qg,nmax)<=0)
	      for (j=1; j<=cl; j++)
	      {
		chi2[j]=lmul((GEN)chi2[j],(GEN)chi12[j]);
		chi1[j]=ladd((GEN)chi2[j],gmul((GEN)chi1[j],(GEN)chi11[j]));
	      }
	  }
	}
	else
	{
	  if (v1) {v=v2; pr=pr2; } else {v=v1; pr=pr1; }
	  if (v==0)
	  {
	    xray=isprincipalray(bnr,pr);
	    chi0=!gcmp1(denom(gauss(subgroup,xray)));
	    xcl=gmul(pass,xray);
	    chi1=chiideal(clgp,listchar,xcl,flag,prec);
	    if (chi0) chi1=gneg(chi1);
	    chi=gcopy(chi1);
	  }
	  while(cmpis(qg,nmax)<=0)
	  {
	    q=qg[2];
	    for(cp=1,i=q; i<=nmax; i+=q,cp++)
	      if(cp%prime[2])
              {
		if (v)
                  for(j=1; j<=cl; j++) coeff(matan,i,j)=zero;
		else
		  for(j=1; j<=cl; j++)
		    coeff(matan,i,j)=lmul((GEN)chi[j],gcoeff(matan,i,j));
              }
	    qg=mulii(qg,prime); al++;
	    if(cmpis(qg,nmax)<=0)
	      for (j=1; j<=cl; j++) chi[j]=lmul((GEN)chi[j],(GEN)chi1[j]);
	  }
	}
	break;
    }
    prime[2] += (*dp++);
  }
  if (flag)
  {
    p1=cgetg(3,t_COMPLEX); p1[1]=zero;
    p1[2]=lmul2n(mppi(prec+1),1);
    z=gexp(gdiv(p1,d1),prec);
    matan=gsubst(lift(matan),0,z);
  }  
  tetpil=avma; return gerepile(av,tetpil,gcopy(matan));
}

static GEN
getallzeta(GEN bnrh, long prec)
{
  long av=avma,tetpil,n,i,j,nmax,cl,lim,av1;
  GEN bnr,bnf,clgp,bid,module,ideal,dk,idno,C,p1,W,matan,c2,cexp,cn,cn2;
  GEN veclprime,veclprime1,veclprime2,veczeta,sig,valchi,subgroup,listchar;
  GEN *gptr[2];

  bnr=(GEN)bnrh[1]; subgroup=(GEN)bnrh[2];
  bnf=(GEN)bnr[1]; clgp=gmael(bnf,8,1); bid=(GEN)bnr[2]; 
  module=(GEN)bid[1]; ideal=(GEN)module[1]; dk=gmael(bnf,7,3);
  listchar=getallchars(bnf);
  constpi(prec+1);
  idno=idealnorm(bnf,ideal); 
  C=gdiv(gsqrt(gmul(idno,dk),prec),gpi);
  p1=isprincipal(bnf,ideal);
  W=chiideal(clgp,listchar,p1,0,prec); /* differente est principale ici */
  nmax=(long)(bit_accuracy(prec)*gtodouble(C)*0.35);
  if(DEBUGLEVEL>=2) fprintferr("nmax = %ld\n",nmax);

  matan=computean(bnr,subgroup,listchar,nmax,prec);
  if(DEBUGLEVEL>=2) fprintferr("an computed\n");

  cl=lg(listchar)-1; veclprime1=cgetg(cl+1,t_VEC);
  for (j=1; j<=cl; j++) veclprime1[j]=zero;
  c2=gdivsg(2,C);
  cexp=gexp(gneg(c2),prec);
  cn=gun; av1=avma; lim=(av1+3*bot)>>2;
  for (n=1; n<=nmax; n++)
  {
    cn=gmul(cn,cexp); cn2=gdivgs(cn,n);
    for (j=1; j<=cl; j++)
      veclprime1[j]=ladd((GEN)veclprime1[j],gmul(cn2,gcoeff(matan,n,j)));
    if (low_stack(lim, (av1+3*bot)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"getallzeta");
      gptr[0]=&cn; gptr[1]=&veclprime1; gerepilemany(av1,gptr,2);
    }
  }
  for (j=1; j<=cl; j++)
    veclprime1[j]=lmul(gmul((GEN)W[j],gconj((GEN)veclprime1[j])),C);
  tetpil=avma; veclprime1=gerepile(av1,tetpil,gcopy(veclprime1));
  if (DEBUGLEVEL>=2) fprintferr("veclprime1 computed\n");

  veclprime2=cgetg(cl+1,t_VEC);
  for (j=1; j<=cl; j++) veclprime2[j]=zero;
  p1=veceint1(stoi(nmax),c2,prec);
  av1=avma; lim=(av1+3*bot)>>2;
  for (n=1; n<=nmax; n++)
  {
    for (j=1; j<=cl; j++)
      veclprime2[j]=ladd((GEN)veclprime2[j],gmul((GEN)p1[n],gcoeff(matan,n,j)));
    if (low_stack(lim, (av1+3*bot)>>1))
    {
      if(DEBUGMEM>1) err(warnmem,"getallzeta");
      tetpil=avma; veclprime2=gerepile(av1,tetpil,gcopy(veclprime2));
    }
  }
  if (DEBUGLEVEL>=2) fprintferr("veclprime2 computed\n");

  veclprime=gadd(gmul2n(veclprime1,-1),veclprime2);
  veczeta=cgetg(cl+1,t_VEC);
  for (i=1; i<=cl; i++)
  {
    sig=(GEN)listchar[i];
    valchi=chiideal(clgp,listchar,sig,0,prec);
    veczeta[i]=ldivgs(gmul(veclprime,gtrans(gconj(valchi))),2*cl);
  }
  tetpil=avma; return gerepile(av,tetpil,greal(veczeta));
}

#if 0
static GEN
recbeta(GEN racpol, GEN beta, long prec)
{
  long av=avma,tetpil,i,bacmin,bacmax,cpt=0;
  GEN p1,p2,v;
  
  p1=cgetg(4,t_VEC); p1[1]=(long)beta; p1[2]=un; p1[3]=(long)racpol;
  bacmin=(long)(.225*bit_accuracy(prec));
  bacmax=(long)(.31*bit_accuracy(prec));
  for (i=bacmax; i>=bacmin; i--)
  {
    p2=lindep2(p1,i);
    if (signe((GEN)p2[1])<0) p2=gneg(p2);
    if (gcmp1((GEN)p2[1]))
    {
      if (!cpt) { v=p2; cpt++; }
      else
      {
	if (!gegal(v,p2)) { v=p2; cpt=1; }
	else cpt++;
      }
      if (cpt>=3) break;
    }
    else cpt=0;
  }
  if (i<bacmin) return NULL;
  tetpil=avma; p1=cgetg(3,t_COL);
  p1[1]=lnegi((GEN)v[2]);
  p1[2]=lnegi((GEN)v[3]); return gerepile(av,tetpil,p1);
}
#endif

GEN
recbeta2(GEN nf, GEN beta, GEN bound)
{
  long i,range;
  GEN om,om1,om2,dom,p1,a,b,bom2;
  
  om=gmael(nf,7,2);
  om1=poleval(om, gmael(nf,6,1));
  om2=poleval(om, gmael(nf,6,2));
  dom=subrr(om1,om2);

  range = 2 * itos(gceil(absr(divir(bound,dom))));
  if (range<1) range=1;
  b = gfloor(gdiv(gsub(bound,beta),dom));
  bom2 = mulir(b,om2);
  for (i=0; i<=range; i++)
  {
    a = ground(gsub(beta,bom2)); 
    p1 = gsub(mpadd(a,bom2), beta);
    if (gexpo(p1) < -32)
    {
      p1 = gadd(a, gmul(b,om));
      return gmodulcp(p1, (GEN)nf[1]);
    }
    b = addis(b,1); bom2 = mpadd(bom2,om2);
  }
  return NULL;
}
  
#if 0
GEN
getpolrelnum(GEN bnf, GEN module, GEN subgroup, long prec)
{
  long av=avma,j,cl;
  GEN bnr,veczeta,conjal,p1,polrel,bnrh;

  bnr=buchrayinitgen(bnf,module,prec);
  bnrh=cgetg(3,t_VEC); bnrh[1]=(long)bnr; bnrh[2]=(long)subgroup;
  veczeta=getallzeta(bnrh,prec);
  if (DEBUGLEVEL>=2) { fprintferr("zetavalues = "); outerr(veczeta); }

  cl=lg(veczeta)-1; conjal=cgetg(cl+1,t_VEC);
  for (j=1; j<=cl; j++)
  {
    p1=gexp(gmul2n((GEN)veczeta[j],1),prec);
    conjal[j]=ladd(p1,ginv(p1));
  }
  polrel=gun;
  for (j=1; j<=cl; j++)
    polrel=gmul(polrel,gsub(polx[0],(GEN)conjal[j]));
  return gerepileupto(av,polrel);
}
#endif

static GEN
makescind(GEN bnf, GEN polrel, long prec)
{
  long i,cl;
  GEN polabs,pollist,pol,pol0,p1,nf,dabs,dk;

  pollist=rnfpolredabs(bnf,polrel,(prec<<1)-2);
  polrel=(GEN)pollist[1];
  if (DEBUGLEVEL>=2) { fprintferr("polrel reduit: "); outerr(polrel); }
  cl=itos(gmael3(bnf,8,1,1));
  polabs=rnfequation(bnf,polrel);
  nf=initalg(polabs,prec);
  dabs=(GEN)nf[3]; dk=gmael(bnf,7,3);
  if (!gegal(dabs,gpuigs(dk,cl))||signe(gmael(nf,2,2)))
    err(bugparier,"quadhilbert");
  p1=polred(nf,(prec<<1)-2);
  for (i=1; i<lg(p1); i++)
  {
    pol=(GEN)p1[i];
    if (degree(pol)==cl)
    {
      if (cl%2) return polredabs(pol,prec);
      if (!gegal(sqri(discf(pol)),dabs)) return polredabs(pol,prec);
    }
  }
  p1=subfields(nf,stoi(cl));
  for (i=1; i<lg(p1); i++)
  {
    pol=gmael(p1,i,1);
    if (cl%2) return polredabs(pol,prec);
    if (!gegal(sqri(discf(pol)),(GEN)nf[3])) return polredabs(pol,prec);
  }
  pol0=gmael(bnf,7,1);
  for (i=1; i<lg(p1); i++)
  {
    pol=gmael(p1,i,1);
    if (degree((GEN)compositum(pol0,pol)[1]) == 2*cl) 
      return polredabs(pol,prec);
  }
  err(talker,"bug in makescind: no polynomial found");
  return NULL; /* not reached */
}

static GEN
quadhilbertdeux(GEN bnf, long prec)
{
  long av=avma,i;
  GEN nf=(GEN)bnf[7],unit,idgen,al,arch,sigal,sigun,sigmun;
  GEN alun,sigalun,w,polrel;
    
  unit=algtobasis(nf,gmael3(bnf,8,5,1));
  idgen=gmael4(bnf,8,1,3,1);
  al=(GEN)isprincipalgen(bnf,idealmul(nf,idgen,idgen))[2];
  arch=cgetg(3,t_COL); arch[1]=arch[2]=un;
  sigal=zsigne(nf,al,arch);
  sigun=zsigne(nf,unit,arch);
  sigmun=gmul(gmodulss(1,2),arch);
  w=cgetg(1,t_VEC);
  if (gcmp0(sigal)) w=concatsp(w,basistoalg(nf,al));
  if (gegal(sigal,sigmun)) w=concatsp(w,gneg(basistoalg(nf,al)));
  if (gcmp0(sigun)) w=concatsp(w,basistoalg(nf,unit));
  if (gegal(sigun,sigmun)) w=concatsp(w,gneg(basistoalg(nf,unit)));
  sigalun=gadd(sigal,sigun);
  alun=basistoalg(nf,element_mul(nf,al,unit));
  if (gcmp0(sigalun)) w=concatsp(w,alun);
  if (gegal(sigalun,sigmun)) w=concatsp(w,gneg(alun));
  polrel=cgetg(5,t_POL); polrel[4]=un; polrel[3]=zero;
  polrel[1]=evallgef(5)|evalsigne(1)|evalvarn(0);
  for (i=1; i<lg(w); i++)
  {
    polrel[2]=lneg((GEN)w[i]);
    if (gcmp1(det((GEN)rnfdiscf(nf,polrel)[1])))
    {
      if (DEBUGLEVEL>=2) { fprintferr("polrel = "); outerr(polrel); }
      return gerepileupto(av,makescind(bnf,polrel,prec));
    }
  }
  err(bugparier,"quadhilbertdeux");
  return NULL; /* not reached */
}

static GEN
quadhilbertreal(GEN D, long prec)
{
  long av=avma,av1,cl,j,cpt=0,debkeep=DEBUGLEVEL,newprec;
  GEN pol,bnf,bnrh,veczeta,conjal,p1,polrel,nf,bound;

  DEBUGLEVEL=0;
  cl=itos((GEN)quadclassunit0(D,0,NULL,prec)[1]);
  if (cl==1) { avma=av; DEBUGLEVEL=debkeep; return polx[0]; }

  pol=quadpoly(D); lisexpr("y"); setvarn(pol,1);
  bnf=bnfinit0(pol,1,NULL,prec); nf=(GEN)bnf[7];
  DEBUGLEVEL=debkeep;
  if (cl==2) return quadhilbertdeux(bnf,prec);

  bnrh=getmodule(bnf,prec); av1=avma;
  if(DEBUGLEVEL>=2)
  {
    fprintferr("\nmodule = "); outerr(gmael3(bnrh,1,2,1));
    fprintferr("subgroup = "); outerr((GEN)bnrh[2]);
  }
  p1=gsqrt(gmul(gmael(bnf,7,3),det(gmael4(bnrh,1,2,1,1))),prec);
  p1=gceil(gmul2n(gdiv(p1,dbltor(2.177)),-TWOPOTBITS_IN_LONG));
  newprec=max(itos(p1)+5,prec);
  if (DEBUGLEVEL>=2) { fprintferr("precision de depart = %ld \n",newprec); } 
   
LABDOUB:
  veczeta=getallzeta(bnrh,newprec);
  if (DEBUGLEVEL>=2) { fprintferr("zetavalues = "); outerr(veczeta); }

  cl=lg(veczeta)-1; conjal=cgetg(cl+1,t_VEC);
  for (j=1; j<=cl; j++)
  {
    p1=gexp(gmul2n((GEN)veczeta[j],1),newprec);
    conjal[j]=ladd(p1,ginv(p1));
  }
  polrel=gun;
  for (j=1; j<=cl; j++)
    polrel=gmul(polrel,gsub(polx[0],(GEN)conjal[j]));
  if (DEBUGLEVEL>=2) { fprintferr("polrelnum = "); outerr(polrel); }

  /* racpol=gmul2n(gsub(gsqrt(D,newprec),(GEN)pol[3]),-1); */
  for (j=2; j<=cl+1; j++)
  {
    bound=shifti(binome(stoi(cl),j-1),cl+1-j);
    p1=recbeta2(nf,greal((GEN)polrel[j]),bound); 
	/* p1=recbeta(racpol,greal((GEN)polrel[j]),prec); */
    if (!p1)
    {
      cpt++;
      if (cpt>=5) err(talker,"insufficient precision in quadhilbert");
      newprec=(newprec<<1)-2;
      if (DEBUGLEVEL) err(warnprec,"quadhilbert",newprec);
      avma=av1; goto LABDOUB;
    }
	/* polrel[j]=(long)basistoalg(bnf,p1);  */
    polrel[j]=(long)p1;
  }
  if (DEBUGLEVEL>=2) { fprintferr("polrel = "); outerr(polrel); }
  return gerepileupto(av,makescind(bnf,polrel,prec));
}

/*******************************************************************/
/*******************************************************************/
/*                                                                 */
/*            Corps de classe de Hilbert avec CM (Schertz)         */
/*                                                                 */
/*******************************************************************/
/*******************************************************************/

int
isoforder2(GEN form)
{
  GEN a=(GEN)form[1],b=(GEN)form[2],c=(GEN)form[3];

  return !(signe(b) && cmpii(a,absi(b)) && cmpii(a,c));
}

/* returns an equation for the Hilbert class field of the imaginary
 *  quadratic field of discriminant D if flag=0, a vector of
 *  two-component vectors [form,g(form)] where g() is the root of the equation
 *  if flag is non-zero.
 */
static GEN
quadhilbertimag(GEN D, GEN flag, long prec)
{
  long av=avma,tetpil,a,b,c,d,dabs,b2,t,h,h2,ell,l,i,i1,i2,ex,e;
  GEN z,sqd,form,L,LG,y,res,ga1,ga2,ga3,ga4,ga,wp,court,p1,p2,qf1,qf2;
  GEN u1,u2,u,w,ag,bg,al,ag2,wlf;
  byteptr p = diffptr;

  if (gcmpgs(D,-11)>=0) return polx[0];
  d=itos(D); L=cgetg(1,t_VEC); 
  b2 = b = (d&1)?1:0; h=h2=0; z=gun; dabs=labs(d);
  sqd = gsqrt(negi(D),prec);
  while(3*b2<=dabs)
  {
    t=(b2-d)/4; a=b?b:1;
    while(a*a<=t)
    {
      if(t%a==0)
      {
	h++; c = t/a;
	form=qfi(stoi(a),stoi(b),stoi(c)); L=concatsp(L,form);
	z=mulsi(a,z);
	if(b && a != b && a*a != t)
	{
	  h++;
	  form=qfi(stoi(a),stoi(-b),stoi(c)); L=concatsp(L,form);
	}
	else h2++;
      }
      a++;
    }
    b+=2; b2=b*b;
  }
  if (h==1) {avma=av; return polx[0];}
  if (DEBUGLEVEL>=2) fprintferr("class number = %ld\n",h);
  wp=cgetg(1,t_VEC); wlf=cgetg(1,t_VEC); court=stoi(5);
  if (typ(flag)==t_VEC)
  {
    for (i=1; i<lg(flag); i++)
    {
      ell=itos((GEN)flag[i]);
      if (smodis(z,ell) && kross(d,ell) > 0)
      {
	court[2]=ell; form=redimag(primeform(D,court,0));
	if (!gcmp1((GEN)form[1]))
	{
	  wp = concat(wp,court); wlf = concat(wlf,form);
	}
      }
    }
  }
  else
  {
    ell=0; ell += *p++; ell+= *p++; 
    while (lg(wp)<=2 || ell<=300)
    {
      ell += *p++; if (!*p) err(primer1);
      if (smodis(z,ell) && kross(d,ell) > 0)
      {
	court[2]=ell; form=redimag(primeform(D,court,0));
	if (!gcmp1((GEN)form[1]))
	{
	  wp = concat(wp,court); wlf = concat(wlf,form);
	}
      }
    }
  }
  l = lg(wp)-1;
  if (l<2) { avma=av; return gzero; }
  if (typ(flag)==t_VEC) { i1=1; i2=2; p1=(GEN)wp[1]; }
  else
  {
    for(i=1; i<=l; i++)
      if (smodis((GEN)wp[i],3) == 1) break;
    i1=(i>l)?1:i; p1=(GEN)wp[i1]; form=(GEN)wlf[i1];
    if (isoforder2(form))
    {
      if (smodis(p1,4)==3)
      {
	for (i=1; i<=l && ((smodis((GEN)wp[i],4) == 3) ||
	     (isoforder2((GEN)wlf[i]) && !gegal((GEN)wlf[i],form))) ;i++);
	if (i>l)
	{
	  for (i=1; i<=l && ((isoforder2((GEN)wlf[i]) && !gegal((GEN)wlf[i],form))) ;i++);
	  if (i>l) { avma=av; return gzero; }
	}
      }
      else
      {
	for (i=1; i<=l && ((isoforder2((GEN)wlf[i]) && !gegal((GEN)wlf[i],form))) ;i++);
	if (i>l) { avma=av; return gzero; }
      }
    }
    else
    {
      if (smodis(p1,4)==3)
      {
	for(i=1; i<=l; i++)
	  if (smodis((GEN)wp[i],4) == 1) break;
	if (i>l) i=1; 
      }
      else i=1;
    }
    i2=i;
  }
  qf1 = primeform(D,p1,0); u1 = gmodulcp((GEN)qf1[2],shifti(p1,1));
  p2 = (GEN)wp[i2];
  qf2 = primeform(D,p2,0); u2 = gmodulcp((GEN)qf2[2],shifti(p2,1));
  ex=24/itos(ggcd(mulii(subis(p1,1),subis(p2,1)),stoi(24)));
  if(DEBUGLEVEL>=2)
  {
    fprintferr("p1, p2:\n"); outerr(p1); outerr(p2);
    fprintferr("ex = %ld\n",ex);
  }
  if (cmpii(p1,p2)) u=lift(chinois(u1,u2));
  else
  {
    if(!gegal(qf1,qf2)) err(talker,"bug in quadhilbertimag");
    u=(GEN)compimagraw(qf1,qf2)[2];
  }
  u=gmodulcp(u,shifti(mulii(p1,p2),1));
  LG=cgetg(1,t_VEC);
  for(i=1;i<=h;i++)
  {
    form=(GEN)L[i];
    ag=(GEN)form[1]; ag2=shifti(ag,1);
    bg=(GEN)form[2];
    w=lift(chinois(gmodulcp(negi(bg),ag2),u));
    al=cgetg(3,t_COMPLEX);
    al[1]=lneg(gdiv(w,ag2));
    al[2]=ldiv(sqd,ag2);
    ga1 = trueeta(gdiv(al,p1),prec);
    ga2 = trueeta(gdiv(al,p2),prec);
    ga3 = trueeta(gdiv(al,mulii(p1,p2)),prec);
    ga4 = trueeta(al,prec);
    ga=gdiv(gmul(ga1,ga2),gmul(ga3,ga4));
    LG=concatsp(LG,gpuigs(ga,ex));
  }
  if ((typ(flag)==t_INT) && signe(flag))
  {
    tetpil=avma; y=cgetg(h+1,t_VEC);
    for(i=1;i<=h;i++)
    {
      res=cgetg(3,t_VEC); y[i]=(long)res;
      res[1]=lcopy((GEN)L[i]); res[2]=lcopy((GEN)LG[i]);
    }
  }
  else
  {
    y=gun;
    for(i=1;i<=h;i++)
      y = gmul(y,gsub(polx[0],(GEN)LG[i]));
    y=greal(y); tetpil=avma; y=grndtoi(y,&e);
    if(e > -10)
      err(warner,"low accuracy in quadhilbert, suggest increasing");
    if ((typ(flag)==t_VEC) && (degree(ggcd(y,deriv(y,0)))>0))
    { avma=av; return gzero; }
  }
  return gerepile(av,tetpil,y);
}

GEN
quadhilbert(GEN D, GEN flag, long prec)
{
  if (typ(D)!=t_INT) err(typeer,"quadhilbert");
  if (!isfundamental(D))
    err(talker,"quadhilbert needs a fundamental discriminant");
  if (signe(D)>0) return quadhilbertreal(D,prec);
  else return quadhilbertimag(D,flag,prec);
}

/*******************************************************************/
/*                                                                 */
/*  Routines related to binary quadratic forms (for internal use)  */
/*                                                                 */
/*******************************************************************/

static void
rhoreal_aux2(GEN x, GEN y)
{
  GEN p1,p2;
  long s = signe(x[3]);

  y[1]=x[3]; setsigne(y[1],1);
  p2 = (cmpii(isqrtD,(GEN)y[1]) >= 0)? isqrtD: (GEN) y[1];
  p1 = shifti((GEN)y[1],1);
  p2 = divii(addii(p2,(GEN)x[2]), p1);
  y[2] = lsubii(mulii(p2,p1),(GEN)x[2]);

  setsigne(y[1],s);
  p1 = shifti(subii(sqri((GEN)y[2]),Disc),-2);
  y[3] = ldivii(p1,(GEN)y[1]);
}

static GEN
rhoreal_aux(GEN x)
{
  GEN y = cgetg(6,t_VEC);
  long e;

  rhoreal_aux2(x,y);
  switch(lg(x))
  {
    case 4: case 5: setlg(y,4); break;
    case 6:
      y[5]=lmulrr(divrr(addir((GEN)x[2],sqrtD),subir((GEN)x[2],sqrtD)),
                  (GEN)x[5]);
      e = expo(y[5]);
      if (e < EXP220) y[4]=x[4];
      else
      { 
        y[4]=laddsi(1,(GEN)x[4]);
        setexpo(y[5], e - EXP220);
      }
    }
  return y;
}

static GEN
rhorealform(GEN x)
{
  long av=avma,tetpil;
  x = rhoreal_aux(x); tetpil=avma;
  return gerepile(av,tetpil,gcopy(x));
}

static GEN
redrealform(GEN x)
{
  long l;
  GEN p1;

  for(;;)
  {
    if (signe(x[2]) > 0 && cmpii((GEN)x[2],isqrtD) <= 0)
    {
      p1 = subii(isqrtD, shifti(absi((GEN)x[1]),1));
      l = absi_cmp((GEN)x[2],p1);
      if (l>0 || (l==0 && signe(p1)<0)) break;
    }
    x = rhoreal_aux(x);
  }
  if (signe(x[1]) < 0)
  {
    if (sens || (signe(x[3])>0 && !absi_cmp((GEN)x[1],(GEN)x[3])))
      return rhoreal_aux(x); /* narrow class group, or a = -c */
    setsigne(x[1],1); setsigne(x[3],-1);
  }
  return x;
}

static GEN
redrealform_init(GEN x)
{
  long av=avma, tetpil;
  GEN y = cgetg(6,t_VEC);

  y[1]=x[1]; y[2]=x[2]; y[3]=x[3]; y[4]=zero;
  y[5]=lgetr(PRECREG); affsr(1,(GEN)y[5]);
  y = redrealform(y); tetpil=avma;
  return gerepile(av,tetpil,gcopy(y));
}

static void
compreal_aux(GEN x, GEN y, GEN z)
{
  GEN s,n,d,d1,x1,x2,y1,y2,v1,v2,b3,c3,m,p1,r;

  s=shifti(addii((GEN)x[2],(GEN)y[2]),-1);
  n=subii((GEN)y[2],s);
  d=bezout((GEN)y[1],(GEN)x[1],&y1,&x1);
  d1=bezout(s,d,&x2,&y2);
  v1=divii((GEN)x[1],d1);
  v2=divii((GEN)y[1],d1);
  m=addii(mulii(mulii(y1,y2),n),mulii((GEN)y[3],x2));
  setsigne(m,-signe(m));
  r=modii(m,v1); p1=mulii(v2,r); b3=shifti(p1,1);
  c3=addii(mulii((GEN)y[3],d1),mulii(r,addii((GEN)y[2],p1)));

  z[1]=lmulii(v1,v2); 
  z[2]=laddii((GEN)y[2],b3);
  z[3]=ldivii(c3,v1);
}

static GEN
comprealform3(GEN x, GEN y)
{
  long av = avma, tetpil;
  GEN z = cgetg(4,t_VEC);
  compreal_aux(x,y,z); z=redrealform(z); tetpil=avma;
  return gerepile(av,tetpil,gcopy(z));
}

static GEN
comprealform5(GEN x, GEN y)
{
  long av = avma,tetpil,e;
  GEN p1, z = cgetg(6,t_VEC);

  compreal_aux(x,y,z);
  z[5]=lmulrr((GEN)x[5],(GEN)y[5]);
  e=expo(z[5]); p1 = addii((GEN)x[4],(GEN)y[4]);
  if (e < EXP220) z[4] = (long)p1;
  else
  { 
    z[4] = laddsi(1,p1);
    setexpo(z[5], e-EXP220);
  }
  z=redrealform(z); tetpil=avma;
  return gerepile(av,tetpil,gcopy(z));
}

static GEN
initializeform5(long *ex)
{
  long av = avma, i;
  GEN form = powsubfactorbase[1][ex[1]];

  for (i=2; i<=lgsub; i++)
    form = comprealform5(form, powsubfactorbase[i][ex[i]]);
  i=avma; return gerepile(av,i,gcopy(form));
}

/*******************************************************************/
/*                                                                 */
/*                     Common subroutines                          */
/*                                                                 */
/*******************************************************************/

static void
buch_init()
{
  if (DEBUGLEVEL) timer2();
  primfact  = cgeti(100);
  primfact1 = cgeti(100);
  exprimfact  = cgeti(100);
  exprimfact1 = cgeti(100);
  badprim = cgeti(100);
  hashtab = (long**) cgeti(HASHT);
}

double
check_bach(double cbach, double B)
{
  if (cbach > B - 0.01)
   err(talker,"sorry, buchxxx couldn't deal with this field PLEASE REPORT!");
  return min(2*cbach,B);
}

static long
factorisequad(GEN f, long kcz, long limp)
{
  long i,p,k,av,lo;
  GEN q,r, x = (GEN)f[1];

  if (is_pm1(x)) { primfact[0]=0; return 1; }
  av=avma; lo=0;
  if (signe(x) < 0) x = absi(x);
  for (i=1; ; i++)
  {
    p=factorbase[i]; q=dvmdis(x,p,&r);
    if (!signe(r))
    {
      k=0; while (!signe(r)) { x=q; k++; q=dvmdis(x,p,&r); }
      lo++; primfact[lo]=p; exprimfact[lo]=k;
    }
    if (cmpis(q,p)<=0) break;
    if (i==kcz) { avma=av; return 0; }
  }
  p = x[2]; avma=av;
  /* p = itos(x) if lgefint(x)=3 */
  if (lgefint(x)!=3 || p > limhash) return 0;

  if (p != 1 && p <= limp)
  {
    for (i=1; i<=badprim[0]; i++)
      if (p % badprim[i] == 0) return 0;
    lo++; primfact[lo]=p; exprimfact[lo]=1;
    p = 1;
  }
  primfact[0]=lo; return p;
}

static long *
largeprime(long q, long *ex, long np, long nrho)
{
  const long hashv = ((q&2047)-1)>>1;
  long *pt, i;
  
  for (pt = hashtab[hashv]; ; pt = (long*) pt[0])
  {
    if (!pt)
    {
      pt = (long*) gpmalloc((lgsub+4)<<TWOPOTBYTES_IN_LONG);
      *pt++ = nrho; /* nrho = pt[-3] */
      *pt++ = np;   /* np   = pt[-2] */
      *pt++ = q;    /* q    = pt[-1] */
      pt[0] = (long)hashtab[hashv];
      for (i=1; i<=lgsub; i++) pt[i]=ex[i];
      hashtab[hashv]=pt; return NULL;
    }
    if (pt[-1] == q) break;
  }
  for(i=1; i<=lgsub; i++)
    if (pt[i] != ex[i]) return pt;
  return (pt[-2]==np)? (GEN)NULL: pt;
}

static long
badmod8(GEN x)
{
  long r = mod8(x);
  if (!r) return 1;
  if (signe(Disc) < 0) r = 8-r;
  return (r < 4);
}

/* cree factorbase, numfactorbase, vectbase; affecte badprim */
static void
factorbasequad(GEN Disc, long n2, long n)
{
  long i,p,bad, av = avma;
  byteptr d=diffptr;

  numfactorbase = (long*) gpmalloc(sizeof(long)*(n2+1));
  factorbase    = (long*) gpmalloc(sizeof(long)*(n2+1));
  KC=0; bad=0; i=0; p = *d++;
  while (p<=n2)
  {
    switch(krogs(Disc,p))
    {
      case -1: break; /* inert */
      case  0: /* ramified */
      {
        GEN p1 = divis(Disc,p);
	if (smodis(p1,p) == 0)
          if (p!=2 || badmod8(p1)) { badprim[++bad]=p; break; }
        i++; numfactorbase[p]=i; factorbase[i] = -p; break;
      }
      default:  /* split */
        i++; numfactorbase[p]=i; factorbase[i] = p;
    }
    p += *d++; if (!*d) err(primer1);
    if (KC == 0 && p>n) KC = i;
  }
  if (!KC) { free(factorbase); free(numfactorbase); return; }
  KC2 = i;
  vectbase = (long*) gpmalloc(sizeof(long)*(KC2+1));
  for (i=1; i<=KC2; i++)
  { 
    p = factorbase[i];
    vectbase[i]=p; factorbase[i]=labs(p);
  }
  if (DEBUGLEVEL)
  { 
    msgtimer("factor base");
    if (DEBUGLEVEL>7)
    {
      fprintferr("factorbase:\n");
      for (i=1; i<=KC; i++) fprintferr("%ld ",factorbase[i]);
      fprintferr("\n"); flusherr();
    }
  }
  avma=av; badprim[0] = bad;
}

/* cree vectbase and subfactorbase. Affecte lgsub */
static long
subfactorbasequad(double ll, long KC)
{
  long i,j,k,nbidp,p,pro[100], ss;
  GEN p1,y;
  double prod;

  i=0; ss=0; prod=1;
  for (j=1; j<=KC && prod<=ll; j++)
  {
    p = vectbase[j];
    if (p>0) { pro[++i]=p; prod*=p; vperm[i]=j; } else ss++;
  }
  if (prod<=ll) return -1;
  nbidp=i;
  for (k=1; k<j; k++)
    if (vectbase[k]<=0) vperm[++i]=k;

  y=cgetg(nbidp+1,t_COL);
  if (PRECREG) /* real */
    for (j=1; j<=nbidp; j++)
    {
      p1=primeform(Disc,stoi(pro[j]),PRECREG);
      y[j] = (long) redrealform_init(p1);
    }
  else
    for (j=1; j<=nbidp; j++) /* imaginary */
    {
      p1=primeform(Disc,stoi(pro[j]),0);
      y[j] = (long)p1;
    }
  subbase = (long*) gpmalloc(sizeof(long)*(nbidp+1));
  lgsub = nbidp; for (j=1; j<=lgsub; j++) subbase[j]=pro[j];
  if (DEBUGLEVEL>7)
  {
    fprintferr("subfactorbase: ");
    for (i=1; i<=lgsub; i++)
      { fprintferr("%ld: ",subbase[i]); outerr((GEN)y[i]); }
    fprintferr("\n"); flusherr();
  }
  subfactorbase = y; return ss;
}

static void
powsubfact(long n, long a)
{
  GEN unform, **x = (GEN**) gpmalloc(sizeof(GEN*)*(n+1));
  long i,j;

  for (i=1; i<=n; i++)
    x[i] = (GEN*) gpmalloc(sizeof(GEN)*(a+1));
  if (PRECREG) /* real */
  {
    unform=cgetg(6,t_VEC);
    unform[1]=un;
    unform[2]=(mod2(Disc) == mod2(isqrtD))? (long)isqrtD: laddsi(-1,isqrtD);
    unform[3]=lshifti(subii(sqri((GEN)unform[2]),Disc),-2);
    unform[4]=zero;
    unform[5]=lgetr(PRECREG); affsr(1,(GEN)unform[5]);
    for (i=1; i<=n; i++)
    {
      x[i][0] = unform;
      for (j=1; j<=a; j++)
	x[i][j]=comprealform5(x[i][j-1],(GEN)subfactorbase[i]);
    }
  }
  else /* imaginary */
  {
    unform=cgetg(4,t_QFI);
    unform[1]=un;
    unform[2]=mod2(Disc)? un: zero;
    unform[3]=lshifti(absi(Disc),-2);
    for (i=1; i<=n; i++)
    {
      x[i][0] = unform;
      for (j=1; j<=a; j++)
	x[i][j]=compimag(x[i][j-1],(GEN)subfactorbase[i]);
    }
  }
  if (DEBUGLEVEL) msgtimer("powsubfact");
  powsubfactorbase = x;
}

static void
desalloc(long **mat, long KCCO)
{
  long i,*p,*q;

  free(vectbase); free(factorbase); free(numfactorbase);
  if (mat)
  { 
    free(subbase);
    for (i=1; i<lg(subfactorbase); i++) free(powsubfactorbase[i]);
    for (i=1; i<=KCCO; i++) free(mat[i]);
    free(mat); free(powsubfactorbase);
    for (i=1; i<HASHT; i++)
      for (p = hashtab[i]; p; p = q) { q=(long*)p[0]; free(p-3); }
  }
}

/* L-function */
static GEN
lfunc(GEN Disc)
{
  long av=avma, p;
  GEN y=cgetr(DEFAULTPREC);
  byteptr d=diffptr;

  affsr(1,y);
  for(p = *d++; p<=30000; p += *d++)
  {
    if (!*d) err(primer1);
    y = mulsr(p, divrs(y, p-krogs(Disc,p)));
  }
  return gerepileupto(av,y);
}

#define comp(x,y) x? (PRECREG? compreal(x,y): compimag(x,y)): y
static GEN
get_clgp(GEN Disc, GEN mit, GEN *ptmet, long prec)
{
  GEN p1,p2,res,*init, u1u2=smith2(mit), u1=(GEN)u1u2[1], met=(GEN)u1u2[3];
  long c,i,j, l = lg(met);

  u1 = reducemodmatrix(ginv(u1), mit);
  for (c=1; c<l; c++)
    if (gcmp1(gcoeff(met,c,c))) break;
  if (DEBUGLEVEL) msgtimer("smith/class group");
  res=cgetg(c,t_VEC); init = (GEN*)cgetg(l,t_VEC);
  for (i=1; i<l; i++)
    init[i] = primeform(Disc,stoi(labs(vectbase[vperm[i]])),prec);
  for (j=1; j<c; j++)
  {
    p1 = NULL;
    for (i=1; i<l; i++)
    {
      p2 = gpui(init[i], gcoeff(u1,i,j), prec);
      p1 = comp(p1,p2);
    }
    res[j] = (long)p1;
  }
  if (DEBUGLEVEL) msgtimer("generators");
  *ptmet = met; return res;
}

static GEN
extra_relations(long LIMC, long *ex, long nlze, GEN extramatc)
{
  long fpc,p,ep,i,j,k,nlze2, *col, *colg, s = 0, extrarel = nlze+2;
  GEN p1,form, extramat = cgetg(extrarel+1,t_MAT);

  if (DEBUGLEVEL)
  {
    fprintferr("recherche de %ld relations supplementaires\n",extrarel);
    flusherr();
  }
  for (j=1; j<=extrarel; j++) extramat[j]=lgetg(KC+1,t_COL);
  nlze2 = PRECREG? max(nlze,lgsub): min(nlze+1,KC);
  while (s<extrarel)
  {
    form = NULL;
    for (i=1; i<=nlze2; i++)
    { 
      ex[i]=mymyrand()>>randshift;
      if (ex[i])
      {
        p1 = primeform(Disc,stoi(factorbase[vperm[i]]),PRECREG);
        p1 = gpuigs(p1,ex[i]); form = comp(form,p1);
      }
    }
    if (!form) continue;

    fpc = factorisequad(form,KC,LIMC);
    if (fpc==1)
    {
      s++; col = (GEN)extramat[s];
      for (i=1; i<=nlze2; i++) col[vperm[i]] = -ex[i];
      for (   ; i<=KC; i++) col[vperm[i]]= 0;
      for (j=1; j<=primfact[0]; j++)
      {
        p=primfact[j]; ep=exprimfact[j];
        if (smodis((GEN)form[2], p<<1) > p) ep = -ep;
        col[numfactorbase[p]] += ep;
      }
      for (i=1; i<=KC; i++)
        if (col[i]) break;
      if (i>KC) s--;
      else if (PRECREG) coeff(extramatc,1,s) = form[4];
    }
    if (DEBUGLEVEL)
    { 
      if (fpc == 1) fprintferr(" %ld",s);
      else if (DEBUGLEVEL>1) fprintferr(".");
      flusherr();
    }
  }
  for (j=1; j<=extrarel; j++)
  {
    colg = cgetg(KC+1,t_COL);
    col = (GEN)extramat[j]; extramat[j] = (long) colg;
    for (k=1; k<=KC; k++)
      colg[k] = lstoi(col[vperm[k]]);
  }   
  if (DEBUGLEVEL)
  {
    fprintferr("\n");
    msgtimer("extra relations");
  }
  return extramat;
}
#undef comp

/*******************************************************************/
/*                                                                 */
/*                    Imaginary Quadratic fields                   */
/*                                                                 */
/*******************************************************************/

static GEN
imag_random_form(long current, long *ex)
{
  long av = avma,i;
  GEN form,pc;

  for(;;)
  {
    form = pc = primeform(Disc,stoi(factorbase[current]),PRECREG);
    for (i=1; i<=lgsub; i++)
    {
      ex[i] = mymyrand()>>randshift;
      if (ex[i])
        form = compimag(form,powsubfactorbase[i][ex[i]]);
    }
    if (form != pc) return form;
    avma = av; /* ex = 0, try again */
  }
}

static void
imag_relations(long lim, long s, long LIMC, long *ex, long **mat)
{
  static long nbtest;
  long av = avma, i,j,pp,fpc,b1,b2,ep,current, first = (s==0);
  long *col,*fpd,*oldfact,*oldexp;
  GEN pc,form,form1;

  if (first) nbtest = 0 ;
  while (s<lim)
  {
    avma=av; nbtest++; current = first? 1+(s%KC): 1+s-RELSUP;
    form = imag_random_form(current,ex);
    fpc = factorisequad(form,KC,LIMC);
    if (!fpc)
    {
      if (DEBUGLEVEL>1) { fprintferr("."); flusherr(); }
      continue;
    }
    if (fpc > 1)
    {
      fpd = largeprime(fpc,ex,current,0);
      if (!fpd)
      {
        if (DEBUGLEVEL>1) { fprintferr("."); flusherr(); }
        continue;
      }
      form1 = powsubfactorbase[1][fpd[1]];
      for (i=2; i<=lgsub; i++)
        form1 = compimag(form1,powsubfactorbase[i][fpd[i]]);
      pc=primeform(Disc,stoi(factorbase[fpd[-2]]),0);
      form1=compimag(form1,pc);
      pp = fpc << 1;
      b1=smodis((GEN)form1[2], pp);
      b2=smodis((GEN)form[2],  pp);
      if (b1 != b2 && b1+b2 != pp) continue;

      s++; col = mat[s];
      if (DEBUGLEVEL) { fprintferr(" %ld",s); flusherr(); }
      oldfact = primfact; oldexp = exprimfact;
      primfact = primfact1; exprimfact = exprimfact1;
      factorisequad(form1,KC,LIMC);

      if (b1==b2)
      {
        for (i=1; i<=lgsub; i++)
          col[numfactorbase[subbase[i]]] = fpd[i]-ex[i];
        col[fpd[-2]]++;
        for (j=1; j<=primfact[0]; j++)
        {
          pp=primfact[j]; ep=exprimfact[j];
          if (smodis((GEN)form1[2], pp<<1) > pp) ep = -ep;
          col[numfactorbase[pp]] -= ep;
        }
      }
      else
      {
        for (i=1; i<=lgsub; i++)
          col[numfactorbase[subbase[i]]] = -fpd[i]-ex[i];
        col[fpd[-2]]--;
        for (j=1; j<=primfact[0]; j++)
        {
          pp=primfact[j]; ep=exprimfact[j];
          if (smodis((GEN)form1[2], pp<<1) > pp) ep = -ep;
          col[numfactorbase[pp]] += ep;
        }
      }
      primfact = oldfact; exprimfact = oldexp;
    }	
    else
    {
      s++; col = mat[s];
      if (DEBUGLEVEL) { fprintferr(" %ld",s); flusherr(); }
      for (i=1; i<=lgsub; i++)
        col[numfactorbase[subbase[i]]] = -ex[i];
    }
    for (j=1; j<=primfact[0]; j++)
    {
      pp=primfact[j]; ep=exprimfact[j];
      if (smodis((GEN)form[2], pp<<1) > pp) ep = -ep;
      col[numfactorbase[pp]] += ep;
    }
    col[current]--;
    if (!first && fpc == 1 && col[current] == 0)
    { 
      s--; for (i=1; i<=KC; i++) col[i]=0;
    }
  }
  if (DEBUGLEVEL)
  {
    char *str = first? "initial": "random";
    fprintferr("\n");
    fprintferr("nbrelations/nbtest = %ld/%ld\n",s,nbtest);
    msgtimer("%s relations",str);
  }
}

static int
imag_be_honest(long *ex)
{
  long p,fpc, s = KC, nbtest = 0, av = avma;
  GEN form;

  while (s<KC2)
  {
    p = factorbase[s+1];
    if (DEBUGLEVEL) { fprintferr(" %ld",p); flusherr(); }
    form = imag_random_form(s+1,ex);
    fpc = factorisequad(form,s,p-1);
    if (fpc == 1) { nbtest=0; s++; }
    else
    {
      nbtest++; if (nbtest>20) return 0;
    }
    avma = av;
  }
  return 1;
}

/*******************************************************************/
/*                                                                 */
/*                      Real Quadratic fields                      */
/*                                                                 */
/*******************************************************************/

static GEN
real_random_form(long *ex)
{
  long av = avma, i;
  GEN p1,form = NULL;

  for(;;)
  {
    for (i=1; i<=lgsub; i++)
    {
      ex[i] = mymyrand()>>randshift;
/*    if (ex[i]) KB: BUG if I put this in. Why ??? */
      {
        p1 = powsubfactorbase[i][ex[i]];
        form = form? comprealform3(form,p1): p1;
      }
    }
    if (form) return form;
    avma = av;
  }
}

static void
real_relations(long lim, long s, long LIMC, long *ex, long **mat, GEN glog2,
               GEN vecexpo)
{
  static long nbtest;
  long av = avma,av1,av2,tetpil,i,j,p,fpc,b1,b2,ep,current, first = (s==0);
  long *col,*fpd,*oldfact,*oldexp,limstack;
  long findecycle,nbrhocumule,nbrho;
  GEN p1,p2,form,form0,form1,form2,*gptr[2];

  limstack=(av+bot)>>1;
  if (first) { nbtest = 0; current = 0; }
  while (s<lim)
  {
    form = real_random_form(ex);
    if (!first)
    {
      current = 1+s-RELSUP;
      p1=redrealform(primeform(Disc,stoi(factorbase[current]),PRECREG));
      form = comprealform3(form,p1);
    }
    form0 = form; form1 = NULL;
    findecycle = nbrhocumule = 0;
    nbrho = -1; av1 = avma;
    while (s<lim)
    {
      if (low_stack(limstack, (av+bot)>>1))
      {
	tetpil=avma;
	if(DEBUGMEM>1) err(warnmem,"real_relations [1]");	
	if (!form1) form=gerepile(av1,tetpil,gcopy(form));
	else
	{
	  gptr[0]=&form1; gptr[1]=&form; gerepilemany(av1,gptr,2);
	}
      }
      if (nbrho < 0) nbrho = 0; /* first time in */
      else
      {
        if (findecycle) break;
        form = rhorealform(form);
        nbrho++; nbrhocumule++;
        if (first)
        {
          if (absi_equal((GEN)form[1],(GEN)form0[1])
                && gegal((GEN)form[2],(GEN)form0[2])
                && (!sens || signe(form0[1])==signe(form[1]))) findecycle=1;
        }
        else
        {
          if (sens || !signe(addii((GEN)form[1],(GEN)form[3])))
            { form=rhorealform(form); nbrho++; }
          else 
            { setsigne(form[1],1); setsigne(form[3],-1); }
          if (gegal((GEN)form[1],(GEN)form0[1]) && 
              gegal((GEN)form[2],(GEN)form0[2])) break;
        }
      }
      nbtest++; fpc = factorisequad(form,KC,LIMC);
      if (!fpc)
      {
        if (DEBUGLEVEL>1) { fprintferr("."); flusherr(); }
        continue;
      } 
      if (fpc > 1)
      {
	fpd = largeprime(fpc,ex,current,nbrhocumule);
        if (!fpd)
        {
          if (DEBUGLEVEL>1) { fprintferr("."); flusherr(); }
          continue;
        }
        if (!form1) form1 = initializeform5(ex);
        if (!first)
        {
          p1 = primeform(Disc,stoi(factorbase[current]),PRECREG);
          p1 = redrealform_init(p1); form1=comprealform5(form1,p1);
        }
	av2=avma;
        for (i=1; i<=nbrho; i++)
	{
	  form1 = rhorealform(form1);
          if (low_stack(limstack, (av+bot)>>1))
	  {
	    if(DEBUGMEM>1) err(warnmem,"real_relations [2]");	
	    tetpil=avma; form1=gerepile(av2,tetpil,gcopy(form1));
	  }
	}
        nbrho = 0; 

        form2=powsubfactorbase[1][fpd[1]];
        for (i=2; i<=lgsub; i++)
          form2 = comprealform5(form2,powsubfactorbase[i][fpd[i]]);
        if (fpd[-2])
        {
          p1 = primeform(Disc,stoi(factorbase[fpd[-2]]), PRECREG);
          p1 = redrealform_init(p1); form2=comprealform5(form2,p1);
        }
	av2=avma;
        for (i=1; i<=fpd[-3]; i++)
	{
          form2 = rhorealform(form2);
          if (low_stack(limstack, (av+bot)>>1))
	  {
	    if(DEBUGMEM>1) err(warnmem,"real_relations [3]");	
	    tetpil=avma; form2=gerepile(av2,tetpil,gcopy(form2));
	  }
	}
        if (!sens && signe(addii((GEN)form2[1],(GEN)form2[3])))
        { 
          setsigne(form2[1],1);
          setsigne(form2[3],-1);
        }
        p = fpc << 1;
        b1=smodis((GEN)form2[2], p);
        b2=smodis((GEN)form1[2], p);
        if (b1 != b2 && b1+b2 != p) continue;

        s++; col = mat[s]; if (DEBUGLEVEL) fprintferr(" %ld",s);
        oldfact = primfact; oldexp = exprimfact;
        primfact = primfact1; exprimfact = exprimfact1;
        factorisequad(form2,KC,LIMC);
        if (b1==b2)
        { 
          for (i=1; i<=lgsub; i++)
            col[numfactorbase[subbase[i]]] = fpd[i]-ex[i];
          for (j=1; j<=primfact[0]; j++)
          {
            p=primfact[j]; ep=exprimfact[j];
            if (smodis((GEN)form2[2], p<<1) > p) ep = -ep;
            col[numfactorbase[p]] -= ep;
          }
          if (fpd[-2]) col[fpd[-2]]++; /* implies !first */
          p1 = subii((GEN)form1[4],(GEN)form2[4]);
          p2 = divrr((GEN)form1[5],(GEN)form2[5]);
        }
        else
        {                
          for (i=1; i<=lgsub; i++)
            col[numfactorbase[subbase[i]]] = -fpd[i]-ex[i];
          for (j=1; j<=primfact[0]; j++)
          {
            p=primfact[j]; ep=exprimfact[j];
            if (smodis((GEN)form2[2], p<<1) > p) ep = -ep;
            col[numfactorbase[p]] += ep;
          }
          if (fpd[-2]) col[fpd[-2]]--;
          p1 = addii((GEN)form1[4],(GEN)form2[4]);
          p2 = mulrr((GEN)form1[5],(GEN)form2[5]);
        }
        primfact = oldfact; exprimfact = oldexp;
      }
      else
      {
	if (!form1) form1 = initializeform5(ex);
        if (!first)
        {
          p1 = primeform(Disc,stoi(factorbase[current]),PRECREG);
          p1 = redrealform_init(p1); form1=comprealform5(form1,p1);
        }
	av2=avma;
	for (i=1; i<=nbrho; i++)
	{
	  form1 = rhorealform(form1);
          if (low_stack(limstack, (av+bot)>>1))
	  {
	    if(DEBUGMEM>1) err(warnmem,"real_relations [4]");	
	    tetpil=avma; form1=gerepile(av2,tetpil,gcopy(form1));
	  }
	}
        nbrho = 0; 

	s++; col = mat[s]; if (DEBUGLEVEL) fprintferr(" %ld",s);
	for (i=1; i<=lgsub; i++)
          col[numfactorbase[subbase[i]]] = -ex[i];
        p1 = (GEN) form1[4];
        p2 = (GEN) form1[5];
      }
      for (j=1; j<=primfact[0]; j++)
      {
        p=primfact[j]; ep=exprimfact[j];
        if (smodis((GEN)form1[2], p<<1) > p) ep = -ep;
        col[numfactorbase[p]] += ep;
      }
      p1 = mpadd(mulir(mulsi(EXP220,p1), glog2), mplog(absr(p2)));
      affrr(shiftr(p1,-1), (GEN)vecexpo[s]);
      if (!first)
      {
        col[current]--;
        if (fpc == 1 && col[current] == 0)
          { s--; for (i=1; i<=KC; i++) col[i]=0; }
        break;
      }
    }
    avma = av;
  }
  if (DEBUGLEVEL)
  {
    char *str = first? "initial": "random";
    fprintferr("\n");
    fprintferr("nbrelations/nbtest = %ld/%ld\n",s,nbtest);
    msgtimer("%s relations",str);
  }
}

static int
real_be_honest(long *ex)
{
  long p,fpc,s = KC,nbtest = 0,av = avma,av1,tetpil,limstack;
  GEN p1,form,form0;

  limstack=(av+bot)>>1;
  while (s<KC2)
  {
    p = factorbase[s+1];
    if (DEBUGLEVEL) { fprintferr(" %ld",p); flusherr(); }
    form = real_random_form(ex);
    p1 = redrealform(primeform(Disc,stoi(p),PRECREG));
    form = comprealform3(form,p1); form0=form;
    for(;;)
    {
      fpc = factorisequad(form,s,p-1);
      if (fpc == 1) { nbtest=0; s++; break; }
      av1=avma;
      form = rhorealform(form); 
      if (low_stack(limstack, (av+bot)>>1))
      {
	if(DEBUGMEM>1) err(warnmem,"real_be_honest");	
	tetpil=avma; form=gerepile(av1,tetpil,gcopy(form));
      }
      nbtest++; if (nbtest>20) return 0;
      if (sens || !signe(addii((GEN)form[1],(GEN)form[3])))
	form = rhorealform(form);
      else
      { 
	setsigne(form[1],1);
	setsigne(form[3],-1);
      }
      if (gegal((GEN)form[1],(GEN)form0[1])
       && gegal((GEN)form[2],(GEN)form0[2])) break;
    }
    avma=av;
  }
  return 1;
}

static GEN
gcdrealnoer(GEN a,GEN b,long *pte)
{
  long e;
  GEN k1,r;

  if (typ(a)==t_INT)
  {
    if (typ(b)==t_INT) return mppgcd(a,b);
    k1=cgetr(lg(b)); affir(a,k1); a=k1;
  }
  else if (typ(b)==t_INT)
    { k1=cgetr(lg(a)); affir(b,k1); b=k1; }
  if (expo(a)<-5) return absr(b);
  if (expo(b)<-5) return absr(a);
  a=absr(a); b=absr(b);
  while (expo(b) >= -5  && signe(b))
  {
    k1=gcvtoi(divrr(a,b),&e);
    if (e > 0) return NULL;
    r=subrr(a,mulir(k1,b)); a=b; b=r;
  }
  *pte=expo(b); return absr(a);
}

static GEN
get_reg(GEN matc, long sreg)
{
  long i,e,maxe;
  GEN reg = mpabs(gcoeff(matc,1,1));
  
  e = maxe = 0;
  for (i=2; i<=sreg; i++)
  {
    reg = gcdrealnoer(gcoeff(matc,1,i),reg,&e);
    if (!reg) return NULL;
    maxe = maxe? max(maxe,e): e;
  }
  if (DEBUGLEVEL)
  {
    if (DEBUGLEVEL>7) { fprintferr("reg = "); outerr(reg); }
    msgtimer("regulator");
  }
  return reg;
}

GEN
buchquad(GEN D, double cbach, double cbach2, long RELSUP0, long flag, long prec)
{
  long av0 = avma,av,tetpil,KCCO,KCCOPRO,i,j,s, *ex,**mat;
  long extrarel,nrelsup,nreldep,LIMC,LIMC2,cp,nbram,nlze,col;
  GEN p1,h,mit,met,res,basecl,dr,c_1,pdep,matc,matalpha,extramat,extramatc;
  GEN reg,vecexpo,glog2,cst;
  double drc,lim,LOGD;

  Disc = D; if (typ(Disc)!=t_INT) err(typeer,"buchquad");
  s=mod4(Disc); 
  switch(signe(Disc))
  {
    case -1:
      if (lgefint(Disc) == 3 && (Disc[2]<=4))
      {
        p1=cgetg(6,t_VEC); p1[1]=p1[4]=p1[5]=un;
        p1[2]=p1[3]=lgetg(1,t_VEC); return p1;
      }
      if (s==2 || s==1) err(funder2,"buchquad");
      PRECREG=0; break;

    case 1:
      if (s==2 || s==3) err(funder2,"buchquad");
      PRECREG=1; break;

    default: err(talker,"zero discriminant in quadclassunit");
  }
  buch_init(); RELSUP = RELSUP0; sens = flag;
  dr=cgetr(3); affir(Disc,dr); drc=fabs(rtodbl(dr)); LOGD=log(drc);
  lim=sqrt(drc); cst = mulrr(lfunc(Disc), dbltor(lim));
  if (!PRECREG) lim /= sqrt(3.);
  cp = (long)exp(sqrt(LOGD*log(LOGD)/8.0)); 
  if (cp < 13) cp = 13;
  av = avma;

INCREASE:
  if (DEBUGLEVEL) { fprintferr("cbach = %f\n",cbach); flusherr(); }
  nreldep = nrelsup = 0;
  LIMC = (long)(cbach*LOGD*LOGD); 
  if (LIMC < cp) LIMC=cp;
  LIMC2 = max(20, (long)(max(cbach,cbach2)*LOGD*LOGD));
  if (LIMC2 < LIMC) LIMC2 = LIMC;
  if (PRECREG)
  {
    PRECREG = max(prec+1, 5 + 2*(gexpo(Disc)>>TWOPOTBITS_IN_LONG));
    glog2  = glog(gdeux,PRECREG);
    sqrtD  = gsqrt(Disc,PRECREG); 
    isqrtD = gfloor(sqrtD);
  }
  factorbasequad(Disc,LIMC2,LIMC);
  if (!KC) { avma=av; cbach = check_bach(cbach,6.); goto INCREASE; }

  vperm = cgeti(KC+1); for (i=1; i<=KC; i++) vperm[i]=i;
  nbram = subfactorbasequad(lim,KC);
  if (nbram == -1)
  {
    desalloc(NULL,0); avma=av;
    cbach = check_bach(cbach,6.); goto INCREASE;
  }
  KCCO = KC + RELSUP;
  if (DEBUGLEVEL) { fprintferr("KC = %ld, KCCO = %ld\n",KC,KCCO); flusherr(); }
  powsubfact(lgsub,CBUCH+7);

  mat = (long**) gpmalloc((KCCO+1)*sizeof(long*));
  for (i=1; i<=KCCO; i++)
  {
    mat[i] = (long*) gpmalloc((KC+1)*sizeof(long));
    for (j=1; j<=KC; j++) mat[i][j]=0;
  }
  ex = cgeti(lgsub+1);
  limhash = (LIMC<(MAXHALFULONG>>1))? LIMC*LIMC: ((ulong)HIGHBIT)>>1;
  for (i=0; i<HASHT; i++) hashtab[i]=NULL;

  s = lgsub+nbram+RELSUP;
  if (PRECREG)
  {
    vecexpo=cgetg(KCCO+1,t_VEC);
    for (i=1; i<=KCCO; i++) vecexpo[i]=lgetr(PRECREG);
    real_relations(s,0,LIMC,ex,mat,glog2,vecexpo);
    real_relations(KCCO,s,LIMC,ex,mat,glog2,vecexpo);
  }
  else
  {
    imag_relations(s,0,LIMC,ex,mat);
    imag_relations(KCCO,s,LIMC,ex,mat);
  }
  if (KC2 > KC)
  {
    if (DEBUGLEVEL)
      fprintferr("be honest for primes from %ld to %ld\n",
                  factorbase[KC+1],factorbase[KC2]);
    s = PRECREG? real_be_honest(ex): imag_be_honest(ex);
    if (DEBUGLEVEL)
    {
      fprintferr("\n");
      msgtimer("be honest");
    }
    if (!s)
    {
      desalloc(mat,KCCO); avma=av;
      cbach = check_bach(cbach,6.); goto INCREASE;
    }
  }
  matc=cgetg(KCCO+1,t_MAT);
  if (PRECREG)
  {
    for (i=1; i<=KCCO; i++)
    { 
      matc[i]=lgetg(2,t_COL); coeff(matc,1,i)=vecexpo[i];
    }
    if (DEBUGLEVEL>7) { fprintferr("matc: "); outerr(matc); flusherr(); }
  }
  else
    for (i=1; i<=KCCO; i++) matc[i]=lgetg(1,t_COL);
  mit = hnfspec(mat,&pdep,&matc,vperm,&matalpha,KCCO,KC,lgsub,&nlze,&col);

  KCCOPRO=KCCO;
  if (nlze)
  {
EXTRAREL:
    s = PRECREG? 2: 1; extrarel=nlze+2; 
    extramatc=cgetg(extrarel+1,t_MAT);
    for (i=1; i<=extrarel; i++) extramatc[i]=lgetg(s,t_COL);
    extramat = extra_relations(LIMC,ex,nlze,extramatc);
    if (nrelsup) nlze=0;
    mit=hnfadd(mit,&pdep,&matc,vperm,&matalpha,KCCOPRO,KC,col,&nlze,
               extramat,extramatc);
    KCCOPRO += extrarel; col = KCCOPRO-lg(matalpha)+1;
    if (nlze)
    {
      nreldep++;
      if (nreldep>5)
      {
        desalloc(mat,KCCO); avma=av;
        cbach = check_bach(cbach,6.); goto INCREASE;
      }
      goto EXTRAREL;
    }
  }
  /* tentative class number */
  h=gun; for (i=1; i<lg(mit); i++) h=mulii(h,gcoeff(mit,i,i));
  if (PRECREG)
  {
    /* tentative regulator */
    reg = get_reg(matc, col-lg(mit)+1);
    if (!reg)
    {
      desalloc(mat,KCCO); avma=av;
      prec = (PRECREG<<1)-2; goto INCREASE;
    }
    if (gexpo(reg)<=-3)
    {
      nrelsup++;
      if (nrelsup<=7)
      {
        if (DEBUGLEVEL) { fprintferr("regulateur nul\n"); flusherr(); }
        nlze=min(KC,nrelsup); goto EXTRAREL;
      }
      desalloc(mat,KCCO); avma=av;
      cbach = check_bach(cbach,6.); goto INCREASE;
    }
    c_1 = divrr(gmul2n(gmul(h,reg),1), cst);
  }
  else
  {
    reg = gun;
    c_1 = divrr(gmul(h,mppi(DEFAULTPREC)), cst);
  }

  if (gcmpgs(gmul2n(c_1,2),3)<0) { c_1=stoi(10); nrelsup=7; }
  if (gcmpgs(gmul2n(c_1,1),3)>0)
  {
    nrelsup++;
    if (nrelsup<=7)
    {
      if (DEBUGLEVEL)
        { fprintferr("***** check = %f\n\n",gtodouble(c_1)); flusherr(); }
      nlze=min(KC,nrelsup); goto EXTRAREL;
    }
    if (cbach < 5.99)
    {
      desalloc(mat,KCCO); avma=av;
      cbach = check_bach(cbach,6.); goto INCREASE;
    }
    err(warner,"suspicious check. Suggest increasing extra relations.");
  }
  basecl = get_clgp(Disc,mit,&met,PRECREG);
  s = lg(basecl); desalloc(mat,KCCO); tetpil=avma;
  
  res=cgetg(6,t_VEC);
  res[1]=lcopy(h); p1=cgetg(s,t_VEC);
  for (i=1; i<s; i++) p1[i] = (long)icopy(gcoeff(met,i,i));
  res[2]=(long)p1;
  res[3]=lcopy(basecl);
  res[4]=lcopy(reg);
  res[5]=lcopy(c_1); return gerepile(av0,tetpil,res);
}

GEN
buchimag(GEN D, GEN c, GEN c2, GEN REL)
{
  return buchquad(D,gtodouble(c),gtodouble(c2),itos(REL), 0,0);
}

GEN
buchreal(GEN D, GEN sens0, GEN c, GEN c2, GEN REL, long prec)
{
  return buchquad(D,gtodouble(c),gtodouble(c2),itos(REL), itos(sens0),prec);
}
