#include "qpsubs.h" 
extern int fancynorm, verbose, plotmode, outnum;
extern FILE *fstdetails;

static Indiv **indm;
static void
wjackestx (double *est, double *sig, double mean, double *jmean, double *jwt,
           int g);
static void
wjackvestx (double *vest, double *var, int d, double *mean, double **jmean,
            double *jwt, int g);
static void
calcndinbreed (int *c1, int *c2, double *pen, double *ped);
static void
calchetinbreed (int *c1, double *pen, double *ped);
static int inbreed = NO;

void
printsc (int tpat[3][4], double tscore[3], char **eglist, double ymin)
{
  int a, b, c, d;
  int *tp, k;

  tp = tpat[0];
  printf ("qscore: ");
  a = tp[0];
  printf ("%15s ", eglist[a]);
  a = tp[1];
  printf ("%15s ", eglist[a]);
  printf ("  ");
  a = tp[2];
  printf ("%15s ", eglist[a]);
  a = tp[3];
  printf ("%15s ", eglist[a]);
  for (k = 0; k < 3; k++)
    {
      tp = tpat[k];
      printf ("%2d ", tp[0]);
      printf ("%2d ", tp[1]);
      printf (" ");
      printf ("%2d ", tp[2]);
      printf ("%2d ", tp[3]);
      printf ("%9.3f", tscore[k]);
    }

  printf ("  %9.3f\n", ymin);
  printnl ();

}
void
xcopy (int rp[4], int a, int b, int c, int d)
{

  rp[0] = a;
  rp[1] = b;
  rp[2] = c;
  rp[3] = d;

}
void
settsc (int tpat[3][4], double tscore[3], int rpat[3][4], double rscore[3])
/// process rscore and return scores in tscore with tscore[0] best
{
  double ww[3], w2[3], y;
  double xmax, xmin;
  int indx[3], i, k;

  vvt (ww, rscore, rscore, 3);
  vmaxmin (ww, 3, &xmax, &xmin);
  vsp (ww, ww, -xmin, 3);
  copyarr (ww, w2, 3);
  vst (ww, ww, -1.0, 3);
  sortit (w2, indx, 3);
  y = w2[1];  // second best score
  vsp (ww, ww, y, 3);

  for (i = 0; i < 3; i++)
    {
      k = indx[i];
      if (i == 0)
        y = rscore[k];
      tscore[i] = ww[k];
      copyiarr (rpat[k], tpat[i], 4);
    }
}

void
getpdata (int *rawcol, double *pm, double *pn, int *xtypes, int nrows,
          int numeg)
{
  int *ytypes, n = 0;
  int i, k, t, g;
  double *data, y;

  vzero (pm, numeg);
  vzero (pn, numeg);

  ZALLOC(ytypes, nrows, int);
  ZALLOC(data, nrows, double);
  for (k = 0; k < nrows; ++k)
    {
      g = rawcol[k];
      t = xtypes[k];
      if (g < 0)
        continue;
      if (t < 0)
        continue;
      data[n] = g;
      ytypes[n] = t;
      ++n;
    }

  if (n <= 1)
    {
      free (ytypes);
      free (data);
      return;
    }
  y = asum (data, n) / (double) n;
// vsp(data, data, -y, n) ; 

  y = 0.5 * y;
  y = y * (1.0 - y);

  if (y < .001)
    {
      free (ytypes);
      free (data);
      return;
    }

  vst (data, data, 1.0 / sqrt (y), n);
  for (i = 0; i < n; i++)
    {
      t = ytypes[i];
      if (t < 0)
        continue;
      if (t >= numeg)
        continue;
      pm[t] += data[i];
      pn[t] += 1.0;
    }

  vsp (pn, pn, 1.0e-8, numeg);
  vvd (pm, pm, pn, numeg);

  free (ytypes);
  free (data);

}

void
gethscore (double *hscore, double *scores, int a, int b, int c, int d,
           int numeg)

{
  hscore[0] = qhdiff (scores, a, b, c, d, numeg);
  hscore[1] = qhdiff (scores, a, b, c, d, numeg);
  hscore[2] = qhdiff (scores, a, b, c, d, numeg);
}

void
getrscore (double *rscore, double *rho, double **zz, int ncols, int a, int b,
           int c, int d, int numeg, int *blabels, int nblocks)

{
  rscore[0] = qcorr (zz, &rho[0], ncols, a, b, c, d, numeg, blabels, nblocks);
  rscore[1] = qcorr (zz, &rho[1], ncols, a, c, b, d, numeg, blabels, nblocks);
  rscore[2] = qcorr (zz, &rho[2], ncols, a, d, b, c, numeg, blabels, nblocks);
}
double
qhdiff (double *scores, int a, int b, int c, int d, int numeg)
{
  double tt[4], xmax, xmin;
  tt[0] = scores[a * numeg + c];
  tt[1] = scores[a * numeg + d];
  tt[2] = scores[b * numeg + c];
  tt[3] = scores[b * numeg + d];
  vmaxmin (tt, 4, &xmax, &xmin);
  return -(xmax - xmin);
}

double
qcorr (double **zz, double *rho, int ncols, int a, int b, int c, int d,
       int numeg, int *blabels, int nblocks)
{
  double *z1, *z2, y, xrho, xsig;
  int u, v;

  u = MIN(a, b);
  v = MAX(a, b);
  z1 = zz[u * numeg + v];

  u = MIN(c, d);
  v = MAX(c, d);
  z2 = zz[u * numeg + v];

  corrwjack (&xrho, &xsig, z1, z2, ncols, blabels, nblocks);
  *rho = xrho;
  y = xrho / xsig;

  return y;

}
int
loadindx (Indiv **xindlist, int *xindex, Indiv **indivmarkers, int numindivs)
{
  int i, n = 0;
  Indiv *indx;
  for (i = 0; i < numindivs; i++)
    {
      indx = indivmarkers[i];
      if (indx->ignore)
        continue;
      if (indx->affstatus == NO)
        continue;
      xindex[n] = i;
      if (xindlist != NULL)
        xindlist[n] = indx;
      ++n;
    }
  return n;
}
int
loadsnpx (SNP **xsnplist, SNP **snpmarkers, int numsnps, Indiv **indivmarkers)
{
  int i, n = 0;
  SNP *cupt;
  for (i = 0; i < numsnps; i++)
    {
      cupt = snpmarkers[i];
      if (cupt->ignore)
        continue;
      if (numvalidgt (indivmarkers, cupt) == 0)
        continue;
      xsnplist[n] = cupt;
      ++n;
    }
  return n;
}

void
getrawcol (int *rawcol, SNP *cupt, int *xindex, int nrows)
{
  int t, j;
  for (j = 0; j < nrows; j++)
    {
      t = xindex[j];
      rawcol[j] = getgtypes (cupt, t);
// if (verbose) printf("www %d %d %d\n", j, t, rawcol[j]) ;
    }
}
void
getrawcolx (int **cc, SNP *cupt, int *xindex, int nrows, Indiv **indm)
{
  int t, j, g, tt;
  int *gg;
  Indiv *indx;
  static int ncall = 0;

  ++ncall;
//  tt = strcmp(cupt -> ID, "rs10914979") ;
  tt = -1;
  for (j = 0; j < nrows; j++)
    {
      t = xindex[j];
      gg = cc[j];
      ivclear (gg, -1, 2);
      g = getgtypes (cupt, t);

      if (g < 0)
        continue;
      gg[0] = g;
      gg[1] = 2 - g;
      if (cupt->chrom != 23)
        continue;
      if (indm[t]->gender != 'M')
        continue;
      if (g == 1)
        {
          ivclear (gg, -1, 2);
          continue;
        }
      g = g / 2;
      gg[0] = g;
      gg[1] = 1 - g;
    }
}

void
getcolx (double *xcol, SNP *cupt, int *xindex, int nrows, int col,
         double *xmean, double *xfancy)
// side effect set xmean xfancy
{
  Indiv *indx;
  int j, n, g, t;
  double y, pmean, p;
  int *rawcol;

  ZALLOC(rawcol, nrows, int);
  n = cupt->ngtypes;
  if (n < nrows)
    fatalx ("bad snp: %s %d\n", cupt->ID, n);
  getrawcol (rawcol, cupt, xindex, nrows);
  floatit (xcol, rawcol, nrows);

  vadjust (xcol, nrows, &pmean);
  if (fancynorm)
    {
      p = 0.5 * pmean;   // autosomes
      y = p * (1.0 - p);
      if (y <= 0.0)
        return;
      y = 1.0 / sqrt (y);
      vst (xcol, xcol, y, nrows);
    }
  else
    y = 1.0;
  if (xmean != NULL)
    {
      xmean[col] = pmean * y;
      xfancy[col] = y;
    }
  free (rawcol);
}
void
loadxdataind (double *xrow, SNP **snplist, int ind, int ncols)
{
  SNP *cupt;
  Indiv *indx;
  int i, j, k, n, g;

  for (i = 0; i < ncols; i++)
    {
      cupt = snplist[i];
      g = getgtypes (cupt, ind);
      xrow[i] = (double) g;
    }
}
void
fixxrow (double *xrow, double *xmean, double *xfancy, int len)
{
  int i;

  vvt (xrow, xrow, xfancy, len);
  for (i = 0; i < len; i++)
    {
      if (xrow[i] < -0.1)
        xrow[i] = 0.0;
      else
        xrow[i] -= xmean[i];
    }
}

void
dofancy (double *cc, int n, double *fancy)
{
  int i, t, nmiss = 0;
  int top, bot;
  double p, yvar, y;

  top = bot = 0;
  for (i = 0; i < n; i++)
    {
      t = nnint (cc[i]);
      if (t < 0)
        {
          ++nmiss;
          continue;
        }
      top += t;
      bot += 2;
    }
  if (bot == 0)
    return;
  if (top == 0)
    return;
  if (top == bot)
    return;
  p = (double) top / ((double) bot);
  yvar = p * (1.0 - p);
  y = 1.0 / sqrt (yvar);
  vst (cc, cc, y, n);
  *fancy = y;
}

int
vadjust (double *cc, int n, double *pmean)
/* take off mean  force missing to zero */
{
  double ynum, ysum, y, ymean;
  int i, nmiss = 0;

  ynum = ysum = 0.0;
  for (i = 0; i < n; i++)
    {
      y = cc[i];
      if (y < 0.0)
        {
          ++nmiss;
          continue;
        }
      ++ynum;
      ysum += y;
    }
  if (ynum == 0.0)
    fatalx ("logic bug all missing\n");
  ymean = ysum / ynum;
  for (i = 0; i < n; i++)
    {
      y = cc[i];
      if (y < 0.0)
        cc[i] = 0.0;
      else
        cc[i] -= ymean;
    }
  if (pmean != NULL)
    *pmean = ymean;
  return nmiss;
}

double
yll (double x1, double x2, double xlen)
{
  double m1, m2, var;

  if (xlen < 1.5)
    return 0.0;
  m1 = x1 / xlen;
  m2 = x2 / xlen;
  var = m2 - m1 * m1;
  if (var <= 0.0)
    fatalx ("bad yll\n");
  return -0.5 * xlen * log (var);
}
void
calcmean (double *wmean, double *vec, int len, int *xtypes, int numeg)
{

  int i, k;
  double y1;
  double *w0, *popsize;

  ZALLOC(w0, len, double);
  ZALLOC(popsize, numeg, double);

  y1 = asum (vec, len) / (double) len;  // mean
  vsp (w0, vec, -y1, len);

  vzero (wmean, numeg);

  for (i = 0; i < len; i++)
    {
      k = xtypes[i];
      ++popsize[k];
      wmean[k] += w0[i];
    }

  vsp (popsize, popsize, 1.0e-12, numeg);
  vvd (wmean, wmean, popsize, numeg);

  free (w0);
  free (popsize);

}

void
setmiss (SNP **snpm, int numsnps)
{
  SNP *cupt;
  int i, j, t, n, tot;

  for (i = 0; i < numsnps; i++)
    {
      cupt = snpm[i];
      n = cupt->ngtypes;
      if (n <= 0)
        continue;
      tot = 0;
      for (j = 0; j < n; j++)
        {
          if (getgtypes (cupt, j) >= 0)
            {
              t = 1;
            }
          else
            {
              t = 0;
            }
          putgtypes (cupt, j, t);
          tot += t;
        }
      if (verbose)
        printf ("Valids: %s %d\n", cupt->ID, tot);
    }
}

void
setfvecs (double *fvecs, double *evecs, int nrows, int numeigs)
// plotmode each eigenvector min 0 max 1
{

  double *w;
  double xmax, xmin;
  int i, j;

  ZALLOC(w, nrows, double);

  for (j = 0; j < numeigs; j++)
    {
      copyarr (evecs + j * nrows, w, nrows);
      if (plotmode == NO)
        {
          vst (fvecs + j * nrows, w, 10.0, nrows);
          continue;
        }
      copyarr (w, fvecs + j * nrows, nrows);
    }
  free (w);
}
void
countpops (int ***counts, SNP **xsnplist, int *xindex, int *xtypes, int nrows,
           int ncols)
// countpops is int [ncols][npops][2]  already zero filled
{
  int col, i, g1, g2, g, k1;
  SNP *cupt;
  int *rawcol;

  ZALLOC(rawcol, nrows, int);
  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      getrawcol (rawcol, cupt, xindex, nrows);
      for (i = 0; i < nrows; i++)
        {
          g = rawcol[i];
          k1 = xtypes[i];
          if (k1 < 0)
            continue;
          if (g < 0)
            continue;
          g1 = 0;
          if (g > 0)
            g1 = 1;
          g2 = g - g1;
          if (g1 < 0)
            fatalx ("bug\n");
          if (g2 < 0)
            fatalx ("bug\n");
          if (g1 > 1)
            fatalx ("bug\n");
          if (g2 > 1)
            fatalx ("bug\n");
          ++counts[col][k1][g1];
          ++counts[col][k1][g2];
        }
    }
  free (rawcol);
}

// setidmat used to scale

void
fixrho (double *a, int n)
// turn a into correlation matrix
{
  double *d, *tt, y;
  int i;

  ZALLOC(d, n, double);
  ZALLOC(tt, n*n, double);

  getdiag (d, a, n);

  vsqrt (d, d, n);
  addouter (tt, d, n);

  vvd (a, a, tt, n * n);

  free (d);
  free (tt);

}
void
printdiag (double *a, int n)
{
  double *d, *tt, y;
  int i;

  ZALLOC(d, n, double);
  getdiag (d, a, n);
  y = asum (d, n) / (double) n;
  for (i = 0; i < n; i++)
    {
      printf ("diag: %9.3f\n", d[i] / y);
    }

  free (d);
  abort ();

}

void
addoutersym (double *X, double *v, int n)
{
  int i, j;

  for (i = 0; i < n; i++)
    {
      for (j = i; j < n; j++)
        {
          X[i * n + j] += v[i] * v[j];
        }
    }
}

void
symit (double *X, int n)
{
  int i, j;

  for (i = 0; i < n; i++)
    {
      for (j = i + 1; j < n; j++)
        {
          X[j * n + i] = X[i * n + j];
        }
    }
}

double
divcol (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
        int nrows, int type1, int type2)
/* heterozygosity for 2 pops */
{
  int c1[2], c2[2], *cc;
  int *rawcol;
  int k, g, i;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;

  ZALLOC(rawcol, nrows, int);

  getrawcol (rawcol, cupt, xindex, nrows);

  ivzero (c1, 2);
  ivzero (c2, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (cc == NULL)
        continue;
      g = rawcol[i];
      if (g < 0)
        continue;
      cc[0] += g;
      cc[1] += 2 - g;
    }

  ya = c1[0];
  yb = c1[1];
  yaa = c2[0];
  ybb = c2[1];
  z = ya + yb;
  zz = yaa + ybb;
  if ((z < 0.1) || (zz < 0.1))
    {
      *estn = 0.0;
      *estd = -1.0; /* no data */
      free (rawcol);
      return 0.0;
    }

  en = ya * ybb + yb * yaa;
  ed = z * zz;

  *estn = en;
  *estd = ed;

  free (rawcol);
  return z + zz;

}

void
f3y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
     int type2, int type3)
{
  int c1[2], c2[2], c3[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;

  ZALLOC(rawcol, nrows, int);

  getrawcol (rawcol, cupt, xindex, nrows);

  ivzero (c1, 2);
  ivzero (c2, 2);
  ivzero (c3, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (k == type3)
        cc = c3;
      if (cc == NULL)
        continue;
      g = rawcol[i];
      if (g < 0)
        continue;
      cc[0] += g;
      cc[1] += 2 - g;
    }

  ya = a = c1[0];
  yb = b = c1[1];
  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));

  yaa = c2[0];
  ybb = c2[1];
  yt = yaa + ybb;
  p2 = yaa / yt;

  yaa = c3[0];
  ybb = c3[1];
  yt = yaa + ybb;
  p3 = yaa / yt;

  en = (p1 - p2) * (p1 - p3);
  en -= h1 / z;

  *estn = en;

  free (rawcol);

}

void
f2sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
      int *xtypes, int nrows, int type1, int type2, int type3)
// processes X chromosome correctly
{
  int c1[2], c2[2], c3[2], c4[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
  double z, zz, h1, h2, h3, yt;
  double z2, z3;
  double ywt;
  int **ccc, *ccpt[3];

  ccc = initarray_2Dint (nrows, 2, 0);

  getrawcolx (ccc, cupt, xindex, nrows, indm);

  ivzero (c1, 2);
  ivzero (c2, 2);
  ivzero (c3, 2);

  ccpt[0] = c1;
  ccpt[1] = c2;
  ccpt[2] = c3;

  *estn = 0;
  *estd = -1;

  for (i = 0; i < nrows; i++)
    {

      k = xtypes[i];
      cc = NULL;

      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (k == type3)
        cc = c3;

      if (cc == NULL)
        continue;

      g = ccc[i][0];
      if (g < 0)
        continue;
      cc[0] += g;
      g = ccc[i][1];
      cc[1] += g;

    }

  /**
   printf("qq1: %d  ", cupt -> markernum) ;
   printimat(c1, 1, 2) ;
   */

  for (i = 0; i <= 2; i++)
    {
      cc = ccpt[i];
      a = intsum (cc, 2);
      if (a < 2)
        {
          free2Dint (&ccc, nrows);
          return;
        }
    }

  ya = a = c1[0];
  yb = b = c1[1];
  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;

  h1 = ya * yb / (yt * (yt - 1.0));

  yaa = c2[0];
  ybb = c2[1];
  z2 = yt = yaa + ybb;
  h2 = yaa * ybb / (yt * (yt - 1.0));
  p2 = yaa / yt;

  yaa = c3[0];
  ybb = c3[1];
  z3 = yt = yaa + ybb;
  h3 = yaa * ybb / (yt * (yt - 1.0));
  p3 = yaa / yt;

// h1 0 is OK trap if necessary in calling program

  en = (p2 - p3) * (p2 - p3);
  en -= h2 / z2;
  en -= h3 / z3;

  if (isnan(en))
    fatalx ("f3 bug\n");

  *estn = en;
  *estd = 2.0 * h1;

  free2Dint (&ccc, nrows);

}
void
f3sc (double *estn, double *estd, SNP *cupt, Indiv **indm, int *xindex,
      int *xtypes, int nrows, int type1, int type2, int type3)
// processes X chromosome correctly
{
  int c1[2], c2[2], c3[2], c4[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
  double z, zz, h1, yt;
  double ywt;
  int **ccc, *ccpt[3];

  ccc = initarray_2Dint (nrows, 2, 0);

  getrawcolx (ccc, cupt, xindex, nrows, indm);

  ivzero (c1, 2);
  ivzero (c2, 2);
  ivzero (c3, 2);

  ccpt[0] = c1;
  ccpt[1] = c2;
  ccpt[2] = c3;

  *estn = 0;
  *estd = -1;

  for (i = 0; i < nrows; i++)
    {

      k = xtypes[i];
      cc = NULL;

      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (k == type3)
        cc = c3;

      if (cc == NULL)
        continue;

      g = ccc[i][0];
      if (g < 0)
        continue;
      cc[0] += g;
      g = ccc[i][1];
      cc[1] += g;

    }

  /**
   printf("qq1: %d  ", cupt -> markernum) ;
   printimat(c1, 1, 2) ;
   */

  for (i = 0; i <= 2; i++)
    {
      cc = ccpt[i];
      a = intsum (cc, 2);
      if (a < 2)
        {
          free2Dint (&ccc, nrows);
          return;
        }
    }

  ya = a = c1[0];
  yb = b = c1[1];
  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;

  h1 = ya * yb / (yt * (yt - 1.0));

  yaa = c2[0];
  ybb = c2[1];
  yt = yaa + ybb;
  p2 = yaa / yt;

  yaa = c3[0];
  ybb = c3[1];
  yt = yaa + ybb;
  p3 = yaa / yt;

// h1 0 is OK trap if necessary in calling program

  en = (p1 - p2) * (p1 - p3);
  en -= h1 / z;

  if (isnan(en))
    fatalx ("f3 bug\n");

  *estn = en;
  *estd = 2.0 * h1;

  free2Dint (&ccc, nrows);

}

void
f4yx (double *estn, SNP *cupt, Indiv **indm, int *xindex, int *xtypes,
      int nrows, int type1, int type2, int type3, int type4)
// processes X chromosome correctly
{
  int c1[2], c2[2], c3[2], c4[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;
  int **ccc;

  ccc = initarray_2Dint (nrows, 2, 0);

  getrawcolx (ccc, cupt, xindex, nrows, indm);

  ivzero (c1, 2);
  ivzero (c2, 2);
  ivzero (c3, 2);
  ivzero (c4, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;

      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (k == type3)
        cc = c3;
      if (k == type4)
        cc = c4;

      if (cc == NULL)
        continue;

      g = ccc[i][0];
      if (g < 0)
        continue;
      cc[0] += g;
      g = ccc[i][1];
      cc[1] += g;
    }

  ya = a = c1[0];
  yb = b = c1[1];
  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));

  yaa = c2[0];
  ybb = c2[1];
  yt = yaa + ybb;
  p2 = yaa / yt;

  yaa = c3[0];
  ybb = c3[1];
  yt = yaa + ybb;
  p3 = yaa / yt;

  yaa = c4[0];
  ybb = c4[1];
  yt = yaa + ybb;
  p4 = yaa / yt;
  en = (p1 - p2) * (p3 - p4);

  *estn = en;

  free2Dint (&ccc, nrows);

}

void
f4y (double *estn, SNP *cupt, int *xindex, int *xtypes, int nrows, int type1,
     int type2, int type3, int type4)
{
  int c1[2], c2[2], c3[2], c4[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, p3, p4, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;

  ZALLOC(rawcol, nrows, int);

  getrawcol (rawcol, cupt, xindex, nrows);

  ivzero (c1, 2);
  ivzero (c2, 2);
  ivzero (c3, 2);
  ivzero (c4, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (k == type3)
        cc = c3;
      if (k == type4)
        cc = c4;
      if (cc == NULL)
        continue;
      g = rawcol[i];
      if (g < 0)
        continue;
      cc[0] += g;
      cc[1] += 2 - g;
    }

  ya = a = c1[0];
  yb = b = c1[1];
  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));

  yaa = c2[0];
  ybb = c2[1];
  yt = yaa + ybb;
  p2 = yaa / yt;

  yaa = c3[0];
  ybb = c3[1];
  yt = yaa + ybb;
  p3 = yaa / yt;

  yaa = c4[0];
  ybb = c4[1];
  yt = yaa + ybb;
  p4 = yaa / yt;
  en = (p1 - p2) * (p3 - p4);

  *estn = en;

  free (rawcol);

}

void
fstcolinb (double *estnmat, double *estdmat, SNP *cupt, int *xindex,
           int *xtypes, int nrows, int numeg)
/**
 NP style n, d estimation for inbreeding, Like fstcolyy     
 like fstcoly but a matrix of populations so data is only accessed once 
 */
{
  int *c1, *c2, *cc;
  int *rawcol;
  int k, g, i, j, a, b;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;
  int **ccc, *gg, **ddd;
  static int ncall = 0;
  double het, hetin;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);
  ddd = initarray_2Dint (numeg, 3, 0);

  vzero (estnmat, numeg);
  vclear (estdmat, -1.0, numeg);

  if (indm == NULL)
    {
      ZALLOC(rawcol, nrows, int);
      getrawcol (rawcol, cupt, xindex, nrows);
      for (a = 0; a < nrows; a++)
        {
          g = rawcol[a];
          ccc[a][0] = g;
          ccc[a][1] = 2 - g;
        }
      free (rawcol);
    }

  else
    {
      getrawcolx (ccc, cupt, xindex, nrows, indm);
    }

  ywt = 1.0;

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];

      if (k < 0)
        continue;
      if (k >= numeg)
        continue;

      cc = ddd[k];
      gg = ccc[i];
      g = gg[0];
      if (g < 0)
        continue;
      if (g > 2)
        fatalx ("fstcolyy bug\n");
      if (inbreed == NO)
        ivvp (cc, cc, gg, 2);
      else
        {
          a = g + gg[1];
          if (a == 1)
            g *= 2; // X and male 
          ++cc[g];
        }
    }

  for (i = 0; i < numeg; i++)
    {
      c1 = ddd[i];
      if (intsum (c1, 3) < 2)
        continue;
      calchetinbreed (c1, &het, &hetin);

      estnmat[i] = (het - hetin) * ywt;
      estdmat[i] = het * ywt;
    }

  free2Dint (&ccc, nrows);
  free2Dint (&ddd, numeg);

}

void
fstcolyy (double *estnmat, double *estdmat, SNP *cupt, int *xindex, int *xtypes,
          int nrows, int numeg)
/**
 NP style n, d estimation for fst No ascertainment  
 like fstcoly but a matrix of populations so data is only accessed once 
 */
{
  int *c1, *c2, *cc;
  int *rawcol;
  int k, g, i, j, a, b;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;
  int **ccc, *gg, **ddd;
  static int ncall = 0;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);
  ddd = initarray_2Dint (numeg, 3, 0);

  vzero (estnmat, numeg * numeg);
  vclear (estdmat, -1.0, numeg * numeg);

  for (a = 0; a < numeg; a++)
    {
      estdmat[a * numeg + a] = 0.0;
    }

  if (indm == NULL)
    {
      ZALLOC(rawcol, nrows, int);
      getrawcol (rawcol, cupt, xindex, nrows);
      for (a = 0; a < nrows; a++)
        {
          g = rawcol[a];
          ccc[a][0] = g;
          ccc[a][1] = 2 - g;
        }
      free (rawcol);
    }

  else
    {
      getrawcolx (ccc, cupt, xindex, nrows, indm);
    }

  ywt = 1.0;

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];

      if (k < 0)
        continue;
      if (k >= numeg)
        continue;

      cc = ddd[k];
      gg = ccc[i];
      g = gg[0];
      if (g < 0)
        continue;
      if (g > 2)
        fatalx ("fstcolyy bug\n");
      if (inbreed == NO)
        ivvp (cc, cc, gg, 2);
      else
        {
          a = g + gg[1];
          if (a == 1)
            g *= 2; // X and male 
          ++cc[g];
        }
    }

  for (i = 0; i < numeg; i++)
    {
      if (inbreed != YES)
        break;
      for (j = i + 1; j < numeg; j++)
        {
          c1 = ddd[i];
          c2 = ddd[j];
          ya = a = c1[0];
          yb = b = c1[1];
          yaa = c2[0];
          ybb = c2[1];
          if (intsum (c1, 3) < 2)
            continue;
          if (intsum (c2, 3) < 2)
            continue;
          calcndinbreed (c1, c2, &en, &ed);

          if (ed < 0.0)
            fatalx ("logic bug\n");
          estnmat[i * numeg + j] = estnmat[j * numeg + i] = en * ywt;
          estdmat[i * numeg + j] = estdmat[j * numeg + i] = ed * ywt;
        }
    }
  for (i = 0; i < numeg; i++)
    {
      if (inbreed)
        break;
      for (j = i + 1; j < numeg; j++)
        {
          c1 = ddd[i];
          c2 = ddd[j];
          ya = a = c1[0];
          yb = b = c1[1];
          yaa = c2[0];
          ybb = c2[1];
          zz = yaa + ybb;
          z = ya + yb;
          if ((z < 1.5) || (zz < 1.5))
            {
              continue;
            }

          z = ya + yb;

          yt = ya + yb;
          p1 = ya / yt;
          h1 = ya * yb / (yt * (yt - 1.0));  // 2 h1 is heterozygosity

          yt = yaa + ybb;
          p2 = yaa / yt;
          h2 = yaa * ybb / (yt * (yt - 1.0));

          en = (p1 - p2) * (p1 - p2);
          en -= h1 / z;
          en -= h2 / zz;

          ed = en;
          ed += h1;
          ed += h2;

          if (ed < 0.0)
            fatalx ("logic bug\n");
          estnmat[i * numeg + j] = estnmat[j * numeg + i] = en * ywt;
          estdmat[i * numeg + j] = estdmat[j * numeg + i] = ed * ywt;
        }
    }

  free2Dint (&ccc, nrows);
  free2Dint (&ddd, numeg);

}

double
fstcoly (double *estn, double *estd, SNP *cupt, int *xindex, int *xtypes,
         int nrows, int type1, int type2)
/** NP style n, d estimation for fst No ascertainment  */
{
  int c1[2], c2[2], *cc;
  int *rawcol;
  int k, g, i, a, b;
  double ya, yb, yaa, ybb, p1, p2, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;
  int **ccc, *gg;
  static int ncall = 0;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);

  if (indm == NULL)
    {
      ZALLOC(rawcol, nrows, int);
      getrawcol (rawcol, cupt, xindex, nrows);
      for (a = 0; a < nrows; a++)
        {
          g = rawcol[a];
          ccc[a][0] = g;
          ccc[a][1] = 2 - g;
        }
      free (rawcol);
    }

  else
    {
      getrawcolx (ccc, cupt, xindex, nrows, indm);
    }

  ivzero (c1, 2);
  ivzero (c2, 2);

  for (i = 0; i < nrows; i++)
    {
      k = xtypes[i];
      cc = NULL;
      gg = ccc[i];
      if (ncall == -11)
        {
          printf ("zzindx1:  %s\n", indm[230]->egroup);
          printf ("zz2 %d %d ", type1, type2);
          printf ("%3d %d %3d %3d\n", i, k, gg[0], gg[1]);
        }
      if (k == type1)
        cc = c1;
      if (k == type2)
        cc = c2;
      if (cc == NULL)
        continue;
      g = gg[0];
      if (g < 0)
        continue;
      ivvp (cc, cc, gg, 2);
    }

  ya = a = c1[0];
  yb = b = c1[1];
  yaa = c2[0];
  ybb = c2[1];
  zz = yaa + ybb;
  z = ya + yb;
  if ((z < 1.5) || (zz < 1.5))
    {
      *estn = 0.0;
      *estd = -1.0; /* no data in column */
      free2Dint (&ccc, nrows);
      return 0.0;
    }

  ywt = ya * yb / (z * (z - 1.0)); // z must be at least 2 
  ywt = 1.0;

  z = ya + yb;

  yt = ya + yb;
  p1 = ya / yt;
  h1 = ya * yb / (yt * (yt - 1.0));  // 2 h1 is heterozygosity

  yt = yaa + ybb;
  p2 = yaa / yt;
  h2 = yaa * ybb / (yt * (yt - 1.0));

  en = (p1 - p2) * (p1 - p2);
  en -= h1 / z;
  en -= h2 / zz;

  ed = en;
  ed += h1;
  ed += h2;

  if (ed < 0.0)
    fatalx ("logic bug\n");

  *estn = en * ywt;
  *estd = ed * ywt;

  /**
   printf("zz %20s %2d %2d  ", cupt ->ID, type1, type2) ;
   printf("%3d %3d ", c1[0], c1[1]) ;
   printf("%3d %3d ", c2[0], c2[1]) ;

   printf(" %9.3f %9.3f", *estn, *estd) ;
   printnl() ;
   */

  free2Dint (&ccc, nrows);
  return z + zz;

}
void
setplimit (Indiv **indivmarkers, int numindivs, char **eglist, int numeg,
           int plimit)
{
  int *indnums;
  int *psize;
  int i, k, kk;
  Indiv *indx;

  ZALLOC(indnums, numindivs, int);
  ZALLOC(psize, numeg, int);

  idperm (indnums, numindivs);
  ranperm (indnums, numindivs);

  for (i = 0; i < numindivs; i++)
    {
      k = indnums[i];
      indx = indivmarkers[k];
      if (indx->ignore)
        continue;
      kk = indxindex (eglist, numeg, indx->egroup);
      if (kk < 0)
        continue;
      ++psize[kk];
      if (psize[kk] > plimit)
        indx->ignore = YES;
    }

  free (psize);
  free (indnums);

}

double
dohzg (double *top, double *bot, SNP **xsnplist, int *xindex, int *xtypes,
       int nrows, int ncols, int numeg)

{

  int t1, t2;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int k, g, i, col, j;
  double ya, yb, y;
  double *xtop, *xbot;
  SNP *cupt;

  vzero (top, numeg * numeg);
  vzero (bot, numeg * numeg);

  ZALLOC(rawcol, nrows, int);
  ZALLOC(pop0, numeg, int);
  ZALLOC(pop1, numeg, int);
  ZALLOC(popall, numeg, int);

  for (col = 0; col < ncols; ++col)
    {
      ivzero (popall, numeg);
      ivzero (pop0, numeg);
      ivzero (pop1, numeg);
      cupt = xsnplist[col];
      getrawcol (rawcol, cupt, xindex, nrows);
      for (i = 0; i < nrows; i++)
        {
          k = xtypes[i];
          g = rawcol[i];
          if (g < 0)
            continue;
          pop1[k] += g;
          pop0[k] += 2 - g;
          popall[k] += 2;  // code needs chamging for X  
        }
      for (k = 0; k < numeg; k++)
        {
          ya = pop0[k];
          yb = pop1[k];
          top[k * numeg + k] += 2 * ya * yb;
          y = ya + yb;
          bot[k * numeg + k] += y * (y - 1.0);
          for (j = k + 1; j < numeg; j++)
            {
              ya = pop0[j];
              yb = pop1[k];
              y = ya + yb;
              top[k * numeg + j] += ya * yb;
              ya = pop1[j];
              yb = pop0[k];
              top[j * numeg + k] = top[k * numeg + j] += ya * yb;

              ya = popall[k];
              yb = popall[j];
              bot[k * numeg + j] += ya * yb;

              top[j * numeg + k] = top[k * numeg + j];
              bot[j * numeg + k] = bot[k * numeg + j];
            }
        }
    }
  ZALLOC(xtop, numeg*numeg, double);
  ZALLOC(xbot, numeg*numeg, double);
  copyarr (bot, xbot, numeg * numeg);
  y = bal1 (xbot, numeg * numeg);
  vst (xtop, top, 1.0 / y, numeg * numeg);

  free (xtop);
  free (xbot);

  free (rawcol);
  free (pop0);
  free (pop1);
  free (popall);

}

void
setblocks (int *block, int *bsize, int *nblock, SNP **snpm, int numsnps,
           double blocklen)
// block, bsize are first element and block length 
// must have been allocated if not NULL 
{
  int n = 0, i;
  int chrom, xsize, lchrom, olds;
  double fpos, dis, gpos;
  SNP *cupt;

  lchrom = -1;
  xsize = 0;

  fpos = -1.0e20;
  for (i = 0; i < numsnps; i++)
    {
      cupt = snpm[i];
      cupt->tagnumber = -1;
      if (cupt->ignore)
        continue;
      if (cupt->isfake)
        continue;
      chrom = cupt->chrom;
      gpos = cupt->genpos;
      dis = gpos - fpos;
      if ((chrom != lchrom) || (dis >= blocklen))
        {
          if (xsize > 0)
            {
              if (block != NULL)
                block[n] = olds;
              if (bsize != NULL)
                bsize[n] = xsize;
              ++n;
            }
          lchrom = chrom;
          fpos = gpos;
          olds = i;
          xsize = 0;
        }
      cupt->tagnumber = n;
      ++xsize;
    }
  if (xsize > 0)
    {
      if (block != NULL)
        block[n] = olds;
      if (bsize != NULL)
        bsize[n] = xsize;
      ++n;
    }
  *nblock = n;
  return;
}

int
numblocks (SNP **snpm, int numsnps, double blocklen)
{
  int n;

  setblocks (NULL, NULL, &n, snpm, numsnps, blocklen);
  return n;
}

void
corrwjack (double *xrho, double *xsig, double *z1, double *z2, int ncols,
           int *bcols, int nblocks)
{
  double *gdot, *dot, *wdot;
  double **bdot;
  double *djack, *wjack;
  double rho, jest, jsig;
  double y1, y2;
  int bnum, i, k;

  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  ZALLOC(gdot, 6, double);
  ZALLOC(wdot, 6, double);

  bdot = initarray_2Ddouble (nblocks, 6, 0.0);

  for (i = 0; i < ncols; i++)
    {
      bnum = bcols[i];
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      dot = bdot[bnum];
      y1 = z1[i];
      y2 = z2[i];
      dot[0] += y1 * y1;
      dot[1] += y2 * y2;
      dot[2] += y1 * y2;
      dot[3] += y1;
      dot[4] += y2;
      dot[5] += 1.0;
    }
  for (k = 0; k < nblocks; k++)
    {
      dot = bdot[k];
      vvp (gdot, gdot, dot, 6);
    }
  rho = crho (gdot);
// printmatw(gdot, 1, 6, 6) ;
  for (k = 0; k < nblocks; k++)
    {
      dot = bdot[k];
      vvm (wdot, gdot, dot, 6);
      djack[k] = crho (wdot);
    }
  wjackest (&jest, &jsig, rho, djack, wjack, nblocks);
  *xrho = jest;
  *xsig = jsig;

  free (djack);
  free (wjack);
  free (gdot);
  free (wdot);
  free2D (&bdot, nblocks);

}
double
crho (double *stats)
{
  /* correlation from 6 sufficient statistics */
  double m1, m2, top, bot, b1, b2, rr;
  double s1, s2, s11, s22, s12, yn;
  static int ncall = 0;

  ++ncall;
  s11 = stats[0];
  s22 = stats[1];
  s12 = stats[2];
  s1 = stats[3];
  s2 = stats[4];
  yn = stats[5];

  m1 = s1 / yn;
  m2 = s2 / yn;
  top = s12 - yn * m1 * m2;
  b1 = s11 - yn * m1 * m1;
  b2 = s22 - yn * m2 * m2;

  if (ncall < -1)
    {
      printf ("%9.3f\n", m1);
      printf ("%9.3f\n", m2);
      printf ("%9.3f\n", top);
      printf ("%9.3f\n", b1);
      printf ("%9.3f\n", b2);
    }
  rr = top / sqrt (b1 * b2);

  return rr;
}

void
setbcols (SNP **xsnplist, int ncols, int *bcols)
{
  int col, bnum;
  SNP *cupt;

  ivclear (bcols, -1, ncols);
  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      bnum = cupt->tagnumber;
      bcols[col] = bnum;
    }
}

double
doadmlin (double *jest, double *jsig, double *zlin, double *var, SNP **xsnplist,
          int *xindex, int *xtypes, int nrows, int ncols, int numeg,
          int nblocks, double scale, Indiv **indm)
{

  int t1, t2, kret;
  int a, b, c;
  int ng3, ng2;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int k, g, i, col, j, d;
  double ya, yb, y, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot, wt;
  double *w1, *w2, *w3;
  double ytop, ybot;
  double y1, y2, yscal;
  double xest, xsig, ynominal;
  int bnum;

  double *f3, *f3sig;
  double *estmat, *zl, *rhs, errest;
  double *vmean, **vjmean;

  ng2 = numeg * numeg;
  ng3 = numeg * numeg * numeg;

  ZALLOC(f3, ng3, double);
  ZALLOC(f3sig, ng3, double);
  ZALLOC(w1, ng3+2, double);
  ZALLOC(w2, ng3+2, double);
  ZALLOC(estmat, ng3, double);
  ZALLOC(w3, ng3, double);
  ZALLOC(gtop, ng3, double);
  ZALLOC(gbot, ng3, double);
  ZALLOC(wtop, ng3, double);
  ZALLOC(wbot, ng3, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  btop = initarray_2Ddouble (nblocks, ng3, 0.0);
  bbot = initarray_2Ddouble (nblocks, ng3, 0.0);

  d = numeg - 1;
  vjmean = initarray_2Ddouble (nblocks, numeg, 0.0);
  ZALLOC(vmean, numeg, double);

  zl = w1;
  rhs = w2;  // overloading

  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      if (cupt->ignore)
        continue;
      wt = cupt->weight;
      if (wt <= 0.0)
        continue;
      bnum = cupt->tagnumber;
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];

      kret = f3yyx (estmat, cupt, xindex, xtypes, nrows, numeg, indm);
      if (kret < 0)
        continue;
      vst (estmat, estmat, wt * scale, ng3);
      vvp (top, top, estmat, ng3);
      vsp (bot, bot, 1.0, ng3);

    }

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, ng3);
      vvp (gbot, gbot, bot, ng3);
    }

  vsp (w2, gbot, 1.0e-10, ng3);
  vvd (f3, gtop, w2, ng3);

  vzero (zl, numeg);
  estmix (zl + 1, f3, numeg);
  copyarr (zl + 1, vmean, d);

  ynominal = y = estmix (zlin, f3, numeg);

  if (verbose)
    {

      for (i = 0; i < numeg; ++i)
        {
          printf ("f3: base number %d:\n", i);
          printmatw (f3 + i * numeg * numeg, numeg, numeg, numeg);
        }

      printf ("nominal error: %12.6f\n", y);
    }

  ytop = ybot = errest = 0.0;

  vvd (wtop, gtop, gbot, ng3);  // delete-block estimate

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, ng3);
      vvm (wbot, gbot, bot, ng3);
      vsp (wbot, wbot, 1.0e-10, ng3);
      vvd (wtop, wtop, wbot, ng3);  // delete-block estimate
      vzero (zl, numeg);
      djack[k] = estmix (zl + 1, wtop, numeg);
      copyarr (zl + 1, vjmean[k], d);
///  printf("yyy: %4d  %9.3f  %12.6f\n", k, wjack[k], djack[k]) ;
      mulmat (rhs, top, zl, numeg, numeg, 1);
      y = vdot (zl, rhs, numeg);
      ytop += y;
      ybot += bot[0];
      if (verbose)
        printf ("www: %4d  %9.3f  %12.6f\n", k, wjack[k], y);
    }

  errest = ytop / ybot;
// jackknife estimate of standard error for variance
  wjackest (&xest, &xsig, ynominal, djack, wjack, nblocks);
  wjackvest (vmean, var, d, zlin, vjmean, wjack, nblocks);
  *jest = xest;
  *jsig = xsig;

  free (w1);
  free (w2);
  free (w3);
  free (estmat);

  free (gbot);
  free (wtop);
  free (wbot);
  free (djack);
  free (wjack);
  free (f3);
  free (f3sig);

  free (vmean);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);
  free2D (&vjmean, nblocks);

  return errest;

}

void
dof3 (double *f3, double *f3sig, SNP **xsnplist, int *xindex, int *xtypes,
      int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
{

  int t1, t2;
  int a, b, c;
  int ng3;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int k, g, i, col, j;
  double ya, yb, y, jest, jsig, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot, wt;
  double *w1, *w2, *w3;
  double ytop, ybot;
  double y1, y2, yscal;
  int bnum;
  double *estmat;

  ng3 = numeg * numeg * numeg;
  ZALLOC(w1, ng3, double);
  ZALLOC(w2, ng3, double);
  ZALLOC(estmat, ng3, double);
  ZALLOC(w3, ng3, double);
  ZALLOC(gtop, ng3, double);
  ZALLOC(gbot, ng3, double);
  ZALLOC(wtop, ng3, double);
  ZALLOC(wbot, ng3, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  btop = initarray_2Ddouble (nblocks, ng3, 0.0);
  bbot = initarray_2Ddouble (nblocks, ng3, 0.0);

  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      if (cupt->ignore)
        continue;
      wt = cupt->weight;
      if (wt <= 0.0)
        continue;
      bnum = cupt->tagnumber;
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];

      f3yy (estmat, cupt, xindex, xtypes, nrows, numeg);

      if (mode != 2)
        {
          vst (estmat, estmat, wt, ng3);
          vvp (top, top, estmat, ng3);
          vsp (bot, bot, 1.0, ng3);
        }
      else
        {
          vvp (top, top, estmat, ng3);
          vsp (bot, bot, 1.0 / wt, ng3);
        }
    }

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, ng3);
      vvp (gbot, gbot, bot, ng3);
    }

  vsp (w2, gbot, 1.0e-10, ng3);
  vvd (f3, gtop, w2, ng3);

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, ng3);
      vvm (wbot, gbot, bot, ng3);
      vsp (wbot, wbot, 1.0e-10, ng3);
      vvd (top, wtop, wbot, ng3);  // delete-block estimate
    }
  vsp (gbot, gbot, 1.0e-10, ng3);
  vvd (gtop, gtop, gbot, ng3);

  for (a = 0; a < numeg; a++)
    {
      for (b = 0; b < numeg; b++)
        {
          for (c = 0; c < numeg; c++)
            {
              if (a == b)
                continue;
              if (a == c)
                continue;
              if (c < b)
                continue;
              for (k = 0; k < nblocks; k++)
                {
                  top = btop[k];
                  djack[k] = dump3 (top, a, b, c, numeg);
                }

              mean = dump3 (gtop, a, b, c, numeg);
              wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
              bump3 (f3sig, a, b, c, numeg, jsig);
              bump3 (f3sig, a, c, b, numeg, jsig);
            }
        }
    }
  vst (f3, f3, scale, ng3);
  vst (f3sig, f3sig, scale, ng3);

  free (w1);
  free (w2);
  free (w3);
  free (estmat);

  free (gbot);
  free (wtop);
  free (wbot);
  free (djack);
  free (wjack);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);

}
void
bump2 (double *x, int a, int b, int n, double val)
{
  int k;
  k = a;
  k *= n;
  k += b;
  x[k] += val;
}
void
bump3 (double *x, int a, int b, int c, int n, double val)
{
  int k;
  k = a;
  k *= n;
  k += b;
  k *= n;
  k += c;
  x[k] += val;
}
double
dump2 (double *x, int a, int b, int n)
{
  int k;
  double val;
  k = a;
  k *= n;
  k += b;
  val = x[k];
  return val;
}
double
dump3 (double *x, int a, int b, int c, int n)
{
  int k;
  double val;
  k = a;
  k *= n;
  k += b;
  k *= n;
  k += c;
  val = x[k];
  return val;
}
void
dof4 (double *f4, double *f4sig, SNP **xsnplist, int *xindex, int *xtypes,
      int nrows, int ncols, int numeg, int nblocks, double scale, int mode)
{

  int t1, t2;
  int a, b, c, d;
  int ng4;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int k, g, i, col, j;
  double ya, yb, y, jest, jsig, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot, wt;
  double *w1, *w2, *w3;
  double ytop, ybot;
  double y1, y2, yscal;
  int bnum;
  int nloop = 0;

  ng4 = numeg * numeg * numeg * numeg;
  ZALLOC(w1, ng4, double);
  ZALLOC(w2, ng4, double);
  ZALLOC(w3, ng4, double);
  ZALLOC(gtop, ng4, double);
  ZALLOC(gbot, ng4, double);
  ZALLOC(wtop, ng4, double);
  ZALLOC(wbot, ng4, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  btop = initarray_2Ddouble (nblocks, ng4, 0.0);
  bbot = initarray_2Ddouble (nblocks, ng4, 0.0);

  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      if (cupt->ignore)
        continue;
      wt = cupt->weight;
      if (wt <= 0.0)
        continue;
      bnum = cupt->tagnumber;
      if (bnum < 0)
        continue;
      if (bnum >= nblocks)
        fatalx ("logic bug\n");
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];

      for (a = 0; a < numeg; a++)
        {
          for (b = 0; b < numeg; b++)
            {
              for (c = 0; c < numeg; c++)
                {
                  for (d = 0; d < numeg; d++)
                    {

                      if (a == b)
                        continue;
                      if (a == c)
                        continue;
                      if (a == d)
                        continue;
                      if (b == c)
                        continue;
                      if (b == d)
                        continue;
                      if (c == d)
                        continue;

                      if (b < a)
                        continue;
                      if (c < a)
                        continue;
                      if (d < a)
                        continue;
                      if (d < c)
                        continue;

                      f4y (&ytop, cupt, xindex, xtypes, nrows, a, b, c, d);
                      ++nloop;
                      //  if (nloop<100) printf("zz1 %d %d %d %d %9.3f\n", a, b, c, d, ytop)  ;
                      if (isnan(ytop))
                        fatalx ("zznan\n");

                      if (mode != 2)
                        {
                          bump4x (top, a, b, c, d, numeg, wt * ytop);
                          bump4x (top, b, a, c, d, numeg, -wt * ytop);
                          bump4x (bot, a, b, c, d, numeg, 1.0);
                          bump4x (bot, b, a, c, d, numeg, 1.0);
                        }
                      else
                        {
                          bump4x (top, a, b, c, d, numeg, ytop);
                          bump4x (top, b, a, c, d, numeg, -ytop);
                          bump4x (bot, a, b, c, d, numeg, 1.0 / wt);
                          bump4x (bot, b, a, c, d, numeg, 1.0 / wt);
                        }

                    }
                }
            }
        }
    }

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, ng4);
      vvp (gbot, gbot, bot, ng4);
    }

  vsp (w2, gbot, 1.0e-10, ng4);
  vvd (f4, gtop, w2, ng4);

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, ng4);
      vvm (wbot, gbot, bot, ng4);
      vsp (wbot, wbot, 1.0e-10, ng4);
      vvd (top, wtop, wbot, ng4);  // delete-block estimate
    }
  vsp (gbot, gbot, 1.0e-10, ng4);
  vvd (gtop, gtop, gbot, ng4);

  for (a = 0; a < numeg; a++)
    {
      for (b = 0; b < numeg; b++)
        {
          for (c = 0; c < numeg; c++)
            {
              for (d = 0; d < numeg; d++)
                {
                  if (a == b)
                    continue;
                  if (a == c)
                    continue;
                  if (a == d)
                    continue;
                  if (b == c)
                    continue;
                  if (b == d)
                    continue;
                  if (c == d)
                    continue;

                  if (b < a)
                    continue;
                  if (c < a)
                    continue;
                  if (d < a)
                    continue;
                  if (d < c)
                    continue;

                  for (k = 0; k < nblocks; k++)
                    {
                      top = btop[k];
                      djack[k] = dump4 (top, a, b, c, d, numeg);
                    }

                  mean = dump4 (gtop, a, b, c, d, numeg);
                  wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
                  bump4x (f4sig, a, b, c, d, numeg, jsig);
                  bump4x (f4sig, b, a, c, d, numeg, jsig);
                }
            }
        }
    }
  vst (f4, f4, scale, ng4);
  vst (f4sig, f4sig, scale, ng4);

  free (w1);
  free (w2);
  free (w3);

  free (gbot);
  free (wtop);
  free (wbot);
  free (djack);
  free (wjack);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);

}

void
bump4x (double *x, int a, int b, int c, int d, int n, double val)
{
  bump4 (x, a, b, c, d, n, val);
  bump4 (x, b, a, d, c, n, val);
  bump4 (x, c, d, a, b, n, val);
  bump4 (x, d, c, b, a, n, val);
}

void
bump4 (double *x, int a, int b, int c, int d, int n, double val)
{
  int k;
  k = a;
  k *= n;
  k += b;
  k *= n;
  k += c;
  k *= n;
  k += d;
  x[k] += val;
}
void
set4x (double *x, int a, int b, int c, int d, int n, double val)
{
  set4 (x, a, b, c, d, n, val);
  set4 (x, b, a, d, c, n, val);
  set4 (x, c, d, a, b, n, val);
  set4 (x, d, c, b, a, n, val);
}

void
set4 (double *x, int a, int b, int c, int d, int n, double val)
{
  int k;
  k = a;
  k *= n;
  k += b;
  k *= n;
  k += c;
  k *= n;
  k += d;
  x[k] = val;
}

double
dump4 (double *x, int a, int b, int c, int d, int n)
{
  int k;
  double val;
  k = a;
  k *= n;
  k += b;
  k *= n;
  k += c;
  k *= n;
  k += d;
  val = x[k];
  return val;
}

double
doinbreed (double *inb, double *inbest, double *inbsig, SNP **xsnplist,
           int *xindex, int *xtypes, int nrows, int ncols, int numeg,
           int nblocks, Indiv **indivmarkers)

{

  int t1, t2;
  int a, b;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int t, k, g, i, col, j;
  double ya, yb, y, jest, jsig, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot, wt;
  double *w1, *w2, *w3;
  double ytop, ybot;
  double y1, y2, yscal;
  int bnum;
  int nloop = 0, fstdnum = 0;
  double *ztop, *zbot, qtop, qbot;
  char **eglist;

  indm = indivmarkers;

  ZALLOC(eglist, numeg, char *);
  for (k = 0; k < nrows; ++k)
    {
      if (indm == NULL)
        break;
      j = xtypes[k];
      if (j < 0)
        continue;
      if (j >= numeg)
        continue;
      t = xindex[k];
      eglist[j] = indm[t]->egroup;
    }

  ZALLOC(w1, numeg, double);
  ZALLOC(w2, numeg, double);
  ZALLOC(w3, numeg, double);
  ZALLOC(gtop, numeg, double);
  ZALLOC(gbot, numeg, double);
  ZALLOC(wtop, numeg, double);
  ZALLOC(wbot, numeg, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  ZALLOC(ztop, numeg, double);
  ZALLOC(zbot, numeg, double);
  btop = initarray_2Ddouble (nblocks, numeg, 0.0);
  bbot = initarray_2Ddouble (nblocks, numeg, 0.0);

  vzero (inb, numeg);
  vzero (inbest, numeg);
  vzero (inbsig, numeg);

  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      if (cupt->ignore)
        continue;
      wt = cupt->weight;
      if (wt <= 0.0)
        continue;
      bnum = cupt->tagnumber;
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];

      fstcolinb (ztop, zbot, cupt, xindex, xtypes, nrows, numeg);

      for (a = 0; a < numeg; a++)
        {
          k = a;
          ytop = ztop[k];
          ybot = zbot[k];

          if (ybot < 0.0)
            continue;

          top[k] += ytop;
          bot[k] += ybot;

          w1[k] += ytop;
          w2[k] += ybot;
        }
    }

  vsp (w2, w2, 1.0e-10, numeg);
  vvd (inb, w1, w2, numeg);

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, numeg);
      vvp (gbot, gbot, bot, numeg);
    }

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, numeg);
      vvm (wbot, gbot, bot, numeg);
      vsp (wbot, wbot, 1.0e-10, numeg);
      vvd (top, wtop, wbot, numeg);  // delete-block estimate
    }

  vsp (gbot, gbot, 1.0e-10, numeg);
  vvd (gtop, gtop, gbot, numeg);

  /**
   printf("zzinb\n") ;
   printmat(inb, 1, numeg) ;
   printnl() ;
   printmat(gtop, 1, numeg) ;
   */

  for (i = 0; i < numeg; i++)
    {
      for (k = 0; k < nblocks; k++)
        {
          top = btop[k];
          djack[k] = top[i];
        }

      ++nloop;
      mean = gtop[i];
      wjackest (&jest, &jsig, mean, djack, wjack, nblocks);

      inbest[i] = jest;
      inbsig[i] = jsig;

      if (nloop == -1)
        {
          printf ("inbreedest\n");
          printf ("mean: %9.3f\n", mean);
          printmat (djack, 1, nblocks);
          printnl ();
          printmat (wjack, 1, nblocks);
          printf ("%9.3f %9.3f\n", jest, jsig);
        }
    }

  free (eglist);
  free (w1);
  free (w2);
  free (w3);

  free (gbot);
  free (wtop);
  free (wbot);
  free (ztop);
  free (zbot);
  free (djack);
  free (wjack);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);

  return;

}

double
dofstnumx (double *fst, double *fstest, double *fstsig, SNP **xsnplist,
           int *xindex, int *xtypes, int nrows, int ncols, int numeg,
           int nblocks, Indiv **indivmarkers, int fstmode)

// fstmode is classic mode (smartpca)
// fstmode 2  is fstdmode

{

  int t1, t2;
  int a, b;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int t, k, g, i, col, j;
  double ya, yb, y, jest, jsig, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot, wt;
  double *w1, *w2, *w3;
  double ytop, ybot;
  double y1, y2, yscal;
  int bnum;
  int nloop = 0, fstdnum = 0;
  double *ztop, *zbot, qtop, qbot;
  char **eglist;

  indm = indivmarkers;
  if ((fstdetails != NULL) && (indm == NULL))
    fatalx ("bug in dofstnumx\n");

  ZALLOC(eglist, numeg, char *);
  for (k = 0; k < nrows; ++k)
    {
      if (indm == NULL)
        break;
      j = xtypes[k];
      if (j < 0)
        continue;
      if (j >= numeg)
        continue;
      t = xindex[k];
      eglist[j] = indm[t]->egroup;
    }

  ZALLOC(w1, numeg*numeg, double);
  ZALLOC(w2, numeg*numeg, double);
  ZALLOC(w3, numeg*numeg, double);
  ZALLOC(gtop, numeg*numeg, double);
  ZALLOC(gbot, numeg*numeg, double);
  ZALLOC(wtop, numeg*numeg, double);
  ZALLOC(wbot, numeg*numeg, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  ZALLOC(ztop, numeg*numeg, double);
  ZALLOC(zbot, numeg*numeg, double);
  btop = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
  bbot = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);

  if (nblocks == 1)
    printf ("number of blocks 1: no standard error\n");

  vzero (fst, numeg * numeg);
  vzero (fstest, numeg * numeg);
  vzero (fstsig, numeg * numeg);

  for (col = 0; col < ncols; ++col)
    {
      cupt = xsnplist[col];
      if (cupt->ignore)
        continue;
      wt = cupt->weight;
      if (wt <= 0.0)
        continue;
      bnum = cupt->tagnumber;
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];

      fstcolyy (ztop, zbot, cupt, xindex, xtypes, nrows, numeg);

      for (a = 0; a < numeg; a++)
        {
          for (b = a + 1; b < numeg; b++)
            {
              k = a * numeg + b;
              ytop = ztop[k];
              ybot = zbot[k];
              if (fstdetails != NULL)
                {
                  if (fstdnum == 0)
                    {
                      fprintf (fstdetails, "%20s ", "## pop 1");
                      fprintf (fstdetails, "%20s ", "pop 2");
                      fprintf (fstdetails, "%20s ", "snpname");
                      fprintf (fstdetails, "%20s ", "N");
                      fprintf (fstdetails, "%20s ", "D");
                      fprintf (fstdetails, "%12s ", "Ratio");
                      fprintf (fstdetails, "\n");
                    }
                  fprintf (fstdetails, "%20s ", eglist[a]);
                  fprintf (fstdetails, "%20s ", eglist[b]);
                  fprintf (fstdetails, "%20s ", cupt->ID);
                  fprintf (fstdetails, "%12.6f ", ytop);
                  fprintf (fstdetails, "%12.6f ", ybot);
                  if (ybot > 0.0)
                    fprintf (fstdetails, "%12.6f", ytop / ybot);
                  else
                    fprintf (fstdetails, "%12s", "-");
                  fprintf (fstdetails, "\n");
                  ++fstdnum;
                }

              if (ybot < 0.0)
                continue;

              if (fstmode == NO)
                {
                  top[k] += wt * ytop;
                  bot[k] += 1.0;
                }

              if (fstmode == YES)
                {
                  top[k] += ytop;
                  bot[k] += ybot;
                }

              if (fstmode == 2)
                {
                  top[k] += ytop;
                  bot[k] += 1.0 / wt;
                }

              w1[k] += ytop;
              w2[k] += ybot;
// classic fst estimate

            }
        }
    }
// symmetrize
  for (a = 0; a < numeg; a++)
    {
      for (b = a + 1; b < numeg; b++)
        {
          top[b * numeg + a] = top[a * numeg + b];
          bot[b * numeg + a] = bot[a * numeg + b];
          w1[b * numeg + a] = w1[a * numeg + b];
          w2[b * numeg + a] = w2[a * numeg + b];
        }
    }

  vsp (w2, w2, 1.0e-10, numeg * numeg);
  vvd (fst, w1, w2, numeg * numeg);

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, numeg * numeg);
      vvp (gbot, gbot, bot, numeg * numeg);
    }

  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, numeg * numeg);
      vvm (wbot, gbot, bot, numeg * numeg);
      vsp (wbot, wbot, 1.0e-10, numeg * numeg);
      vvd (top, wtop, wbot, numeg * numeg);  // delete-block estimate
    }
  vsp (gbot, gbot, 1.0e-10, numeg * numeg);
  vvd (gtop, gtop, gbot, numeg * numeg);

  for (i = 0; i < numeg; i++)
    {
      for (j = i + 1; j < numeg; j++)
        {
          for (k = 0; k < nblocks; k++)
            {
              top = btop[k];
              djack[k] = top[i * numeg + j];
            }

          ++nloop;
          mean = gtop[i * numeg + j];
          jest = mean;
          jsig = 0;
          if (nblocks > 1)
            {
              wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
            }
          fstest[i * numeg + j] = fstest[j * numeg + i] = jest;
          fstsig[i * numeg + j] = fstsig[j * numeg + i] = jsig;

          if (nloop == -1)
            {
              printf ("fstest\n");
              printf ("mean: %9.3f\n", mean);
              printmat (djack, 1, nblocks);
              printnl ();
              printmat (wjack, 1, nblocks);
              printf ("%9.3f %9.3f\n", jest, jsig);
            }
        }
    }

  /**
   printf("fst:\n") ;
   printmat(fst, numeg, numeg) ;
   printnl() ;
   printmat(fstest, numeg, numeg) ;
   printnl() ;
   printmat(fstsig, numeg, numeg) ;
   printnl() ;
   */

  yscal = 1.0;
  if (fstmode != YES)
    {
      copyarr (fstsig, w3, numeg * numeg);
      vsp (w3, w3, 1.0e-10, numeg * numeg);
      vvd (w1, fst, w3, numeg * numeg);
      vvd (w2, fstest, w3, numeg * numeg);
//   now do regression  w1 = yscal * w2
      y1 = vdot (w1, w2, numeg * numeg);
      y2 = vdot (w2, w2, numeg * numeg);
      yscal = y1 / y2;
      vst (fstest, fstest, yscal, numeg * numeg);
      vst (fstsig, fstsig, yscal, numeg * numeg);
    }

  free (eglist);
  free (w1);
  free (w2);
  free (w3);

  free (gbot);
  free (wtop);
  free (wbot);
  free (ztop);
  free (zbot);
  free (djack);
  free (wjack);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);

  return yscal;

}

double
dofstnum (double *fst, double *fstest, double *fstsig, SNP **xsnplist,
          int *xindex, int *xtypes, int nrows, int ncols, int numeg,
          int nblocks)
{

  dofstnumx (fst, fstest, fstsig, xsnplist, xindex, xtypes, nrows, ncols, numeg,
             nblocks, NULL, NO);

}

void
setmgpos (SNP **snpm, int numsnps, double *maxgdis)
// find max genetic distance
{
  double minpos, maxdis;
  int chrom, lchrom, i;
  SNP *cupt;

  minpos = 99999.0;
  lchrom = -1;

  maxdis = -9999;
  for (i = 0; i < numsnps; i++)
    {
      cupt = snpm[i];
      chrom = cupt->chrom;
      if (chrom != lchrom)
        {
          lchrom = chrom;
          minpos = cupt->genpos;
        }
      maxdis = MAX(maxdis, cupt->genpos - minpos);
    }
  *maxgdis = maxdis;
}

void
setgfromp (SNP **snpm, int numsnps)
{
  int i;
  SNP *cupt;

  for (i = 0; i < numsnps; i++)
    {
      cupt = snpm[i];
      cupt->genpos = (cupt->physpos) / 1.0e8;
    }
}

void
wjackest (double *est, double *sig, double mean, double *jmean, double *jwt,
          int g)
// test for jwt 0 
{
  double *jjmean, *jjwt;
  int i, n;

  ZALLOC(jjmean, g, double);
  ZALLOC(jjwt, g, double);
  n = 0;

  for (i = 0; i < g; ++i)
    {
      if (jwt[i] < 1.0e-6)
        continue;
      jjmean[n] = jmean[i];
      jjwt[n] = jwt[i];
      ++n;
    }

  wjackestx (est, sig, mean, jjmean, jjwt, n);
  free (jjmean);
  free (jjwt);
}

static void
wjackestx (double *est, double *sig, double mean, double *jmean, double *jwt,
           int g)
// weighted jackknife see wjack.tex
// mean is natural estimate.  jmean[k] mean with block k removed.  jwt is weight for block (sample size)
{

  double *tdiff, *hh, *xtau, *w1, *w2;
  double jackest, yn, yvar;
  int k;

  if (g <= 1)
    fatalx ("(wjackest) number of blocks <= 1\n");
  ZALLOC(tdiff, g, double);
  ZALLOC(hh, g, double);
  ZALLOC(xtau, g, double);
  ZALLOC(w1, g, double);
  ZALLOC(w2, g, double);

  yn = asum (jwt, g);

  vsp (tdiff, jmean, -mean, g);
  vst (tdiff, tdiff, -1.0, g);
  jackest = asum (tdiff, g) + vdot (jwt, jmean, g) / yn;
// this is equation 2

  vclear (hh, yn, g);
  vvd (hh, hh, jwt, g);
  /**
   for (k=0; k<g; ++k) {
   if (jwt[k] > 0.0) hh[k] /= jwt[k] ;  
   else hh[k] *= 1.0e20 ;
   }
   */
// jwt should be positive
  vst (xtau, hh, mean, g);
  vsp (w1, hh, -1.0, g);
  vvt (w2, w1, jmean, g);
  vvm (xtau, xtau, w2, g);

  vsp (xtau, xtau, -jackest, g);
  vvt (xtau, xtau, xtau, g);
  vvd (xtau, xtau, w1, g);
  yvar = asum (xtau, g) / (double) g;
  *est = jackest;
  *sig = sqrt (yvar);

  free (tdiff);
  free (hh);
  free (xtau);
  free (w1);
  free (w2);

}

void
ndfst5 (double *zzest, double *zzsig, double **zn, double **zd, int ncols,
        int *bcols, int nblocks)
{
#define NPAR  5
  double *djack, *wjack;
  double qest, jest, jsig;
  double y1, y2;
  int bnum, i, k;
  int a, b, c;
  double *gn, *gd, **xn, **xd, *xx, *qqest, *test, *tn, *td, **xqest;

  ZALLOC(gn, 4*4, double);
  ZALLOC(gd, 4*4, double);
  ZALLOC(tn, 4*4, double);
  ZALLOC(td, 4*4, double);
  ZALLOC(qqest, NPAR, double);

  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);

  xn = initarray_2Ddouble (nblocks, 4 * 4, 0.0);
  xd = initarray_2Ddouble (nblocks, 4 * 4, 0.0);
  xqest = initarray_2Ddouble (nblocks, NPAR, 0.0);

  for (i = 0; i < ncols; i++)
    {
      bnum = bcols[i];
      if (bnum < 0)
        continue;
      if (bnum >= nblocks)
        fatalx ("bad bug\n");
      ++wjack[bnum];
      for (a = 0; a < 4; a++)
        {
          for (b = a + 1; b < 4; b++)
            {
              c = 4 * a + b;
              xn[bnum][c] += zn[i][c];
              xd[bnum][c] += zd[i][c];
            }
        }
    }
  for (k = 0; k < nblocks; k++)
    {
      xx = xn[k];
      vvp (gn, gn, xx, 4 * 4);
      xx = xd[k];
      vvp (gd, gd, xx, 4 * 4);
    }
  verbose = YES;
  regestit (qqest, gn, gd);
  printf ("qqest: ");
  printmatw (qqest, 1, 5, 5);
  verbose = NO;

  for (k = 0; k < nblocks; k++)
    {
      xx = xn[k];
      vvm (tn, gn, xx, 4 * 4);
      xx = xd[k];
      vvm (td, gd, xx, 4 * 4);
      regestit (xqest[k], tn, td);
    }
  for (a = 0; a < NPAR; a++)
    {
      for (k = 0; k < nblocks; ++k)
        {
          djack[k] = xqest[k][a];
        }
      wjackest (&jest, &jsig, qqest[a], djack, wjack, nblocks);
      zzest[a] = jest;
      zzsig[a] = jsig;
    }

  free2D (&xqest, nblocks);
  free2D (&xn, nblocks);
  free2D (&xd, nblocks);
  free (djack);
  free (wjack);
  free (gn);
  free (gd);
  free (tn);
  free (td);
  free (qqest);
}

void
regestit (double *ans, double *xn, double *xd)
{
  int a, b, c, k;
  double *co, *rr;
  double f;

  ZALLOC(co, 6*5, double);
  ZALLOC(rr, 6, double);

  /**
   printf("zzreg\n") ;
   printmat(xn, 4, 4) ;
   printnl() ;
   printmat(xd, 4, 4) ;
   printnl() ;
   */

  verbose = NO;

  k = 0;
  a = 0;
  b = 1;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 0] = co[k * 5 + 1] = 1;
  rr[k] = f;

  k = 1;
  a = 2;
  b = 3;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 3] = co[k * 5 + 4] = 1;
  rr[k] = f;

  k = 2;
  a = 0;
  b = 2;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 0] = co[k * 5 + 2] = co[k * 5 + 3] = 1;
  rr[k] = f;

  k = 3;
  a = 0;
  b = 3;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 0] = co[k * 5 + 2] = co[k * 5 + 4] = 1;
  rr[k] = f;

  k = 4;
  a = 1;
  b = 2;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 1] = co[k * 5 + 2] = co[k * 5 + 3] = 1;
  rr[k] = f;

  k = 5;
  a = 1;
  b = 3;
  c = 4 * a + b;
  f = xn[c] / xd[c];
  co[k * 5 + 1] = co[k * 5 + 2] = co[k * 5 + 4] = 1;
  rr[k] = f;

  regressit (ans, co, rr, 6, 5);

  free (co);
  free (rr);

}

void
setwt (SNP **snpmarkers, int numsnps, Indiv **indivmarkers, int nrows,
       int *xindex, int *xtypes, char *outpop, char **eglist, int numeg)
{
  int *rawcol;
  SNP *cupt;
  int i, k, j, t, kk, maxeg;
  int a0, a1, aa;
  int **ccx, **ccc, *cc;
  double wt, p;
  int a, g;

  t = strcmp (outpop, "NONE");
  if (t == 0)
    outnum = -1;
  maxeg = MAX(outnum, numeg) + 1;
  ccx = initarray_2Dint (maxeg, 2, 0);
  ccc = initarray_2Dint (nrows, 2, 0);
  t = -1;

// printf("zzqq %d %d\n", outnum, numeg) ;
  for (i = 0; i < numsnps; ++i)
    {
      cupt = snpmarkers[i];
      cupt->weight = 0;
//  t = strcmp(cupt -> ID, "rs10914979") ;
      if (cupt->ignore)
        continue;

      getrawcolx (ccc, cupt, xindex, nrows, indivmarkers);
      iclear2D (&ccx, maxeg, 2, 0);
      for (k = 0; k < nrows; ++k)
        {
          a = xtypes[k];

          if (i == -1)
            {
              printf ("zzq %d %d %d  %d\n", i, k, outnum, ccc[k][0]);
            }

          if (a < 0)
            continue;
          if (a >= maxeg)
            continue;
          g = ccc[k][0];
          if (g < 0)
            continue;
          cc = ccx[a];
          ivvp (cc, cc, ccc[k], 2);
        }

      if (outnum < 0)
        {
          a0 = a1 = 0;
          for (j = 0; j < numeg; ++j)
            {
              a0 += ccx[j][0];
              a1 += ccx[j][1];
            }
        }

      else
        {
          a0 = ccx[outnum][0];
          a1 = ccx[outnum][1];
        }

      aa = a0 + a1;
      if (a0 == 0)
        continue;
      if (a1 == 0)
        continue;
      p = (double) a0 / (double) aa;
      wt = 1.0 / (p * (1.0 - p));
      if (outnum == -99)
        wt = 1.0;

      if (t == 0)
        {
          for (k = 0; k < nrows; ++k)
            {
              printf ("ww1: %d %d %d ", k, xtypes[k], xindex[k]);
              printimat (ccc[k], 1, 2);
            }
        }
      for (k = 0; k < numeg; ++k)
        {
          a0 = ccx[k][0];
          a1 = ccx[k][1];
          aa = a0 + a1;
          if (t == 0)
            printf ("zzyy %d %d %d\n", k, a0, a1);

          if (aa < 2)
            {
              wt = 0;
              break;
            }
          if (k < numeg)
            continue;
        }
      cupt->weight = wt;
    }

  for (i = 0; i < numsnps; ++i)
    {
      cupt = snpmarkers[i];
      if (cupt->weight <= 0.0)
        cupt->ignore = YES;
    }

  free2Dint (&ccx, maxeg);
  free2Dint (&ccc, nrows);

}

void
countg (int *rawcol, int **cc, int *xtypes, int n, int ntypes)
{
  int g, i, c0, c1, k;

  iclear2D (&cc, ntypes, 2, 0);
  for (i = 0; i < n; i++)
    {
      g = rawcol[i];
      if (g < 0)
        continue;
      c0 = g;
      c1 = 2 - g;
      k = xtypes[i];
      if (k < 0)
        continue;
      if (k > ntypes)
        continue;
      cc[k][0] += c0;
      cc[k][1] += c1;
    }
}

void
dohzgjack (double *hest, double *hsig, SNP **xsnplist, int *xindex, int *xtypes,
           int nrows, int ncols, int numeg, int *bcols, int nblocks)
{

  int t1, t2;
  int c1[2], c2[2], *cc;
  int *rawcol, *popall, *pop0, *pop1;
  int k, g, i, col, j;
  double ya, yb, y, jest, jsig, mean;
  SNP *cupt;
  double *top, *bot, *djack, *wjack, *gtop, *gbot, *wbot, *wtop;
  double **btop, **bbot;
  int bnum;

  ZALLOC(gtop, numeg*numeg, double);
  ZALLOC(gbot, numeg*numeg, double);
  ZALLOC(wtop, numeg*numeg, double);
  ZALLOC(wbot, numeg*numeg, double);
  ZALLOC(djack, nblocks, double);
  ZALLOC(wjack, nblocks, double);
  btop = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);
  bbot = initarray_2Ddouble (nblocks, numeg * numeg, 0.0);

  ZALLOC(rawcol, nrows, int);
  ZALLOC(pop0, numeg, int);
  ZALLOC(pop1, numeg, int);
  ZALLOC(popall, numeg, int);

  ivclear (bcols, -1, ncols);

  for (col = 0; col < ncols; ++col)
    {
      ivzero (popall, numeg);
      ivzero (pop0, numeg);
      ivzero (pop1, numeg);
      cupt = xsnplist[col];
      bnum = cupt->tagnumber;
      bcols[col] = bnum;
      if (bnum < 0)
        continue;
      ++wjack[bnum];
      top = btop[bnum];
      bot = bbot[bnum];
      getrawcol (rawcol, cupt, xindex, nrows);
      for (i = 0; i < nrows; i++)
        {
          k = xtypes[i];
          if (k < 0)
            continue;
          if (k >= numeg)
            continue;
          g = rawcol[i];
          if (g < 0)
            continue;
          pop1[k] += g;
          pop0[k] += 2 - g;
          popall[k] += 2;  // code needs chamging for X  
        }
      for (k = 0; k < numeg; k++)
        {
          ya = pop0[k];
          yb = pop1[k];
          top[k * numeg + k] += 2 * ya * yb;
          y = ya + yb;
          bot[k * numeg + k] += y * (y - 1.0);
          for (j = k + 1; j < numeg; j++)
            {
              ya = pop0[j];
              yb = pop1[k];
              y = ya + yb;
              top[k * numeg + j] += ya * yb;
              ya = pop1[j];
              yb = pop0[k];
              top[j * numeg + k] = top[k * numeg + j] += ya * yb;

              ya = popall[k];
              yb = popall[j];
              bot[k * numeg + j] += ya * yb;

              top[j * numeg + k] = top[k * numeg + j];
              bot[j * numeg + k] = bot[k * numeg + j];
            }
        }
    }
  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvp (gtop, gtop, top, numeg * numeg);
      vvp (gbot, gbot, bot, numeg * numeg);
    }
  /**
   for (k=0; k<nblocks; k++) {  
   top = btop[k] ; 
   bot = bbot[k] ;
   vvp(gtop, gtop, top, numeg*numeg) ;
   vvp(gbot, gbot, bot, numeg*numeg) ;
   }
   */
  for (k = 0; k < nblocks; k++)
    {
      top = btop[k];
      bot = bbot[k];
      vvm (wtop, gtop, top, numeg * numeg);
      vvm (wbot, gbot, bot, numeg * numeg);
      vsp (wbot, wbot, 1.0e-10, numeg * numeg);
      vvd (top, wtop, wbot, numeg * numeg);  // delete-block estimate
    }
  vsp (gbot, gbot, 1.0e-10, numeg * numeg);
  vvd (gtop, gtop, gbot, numeg * numeg);
  for (i = 0; i < numeg; i++)
    {
      for (j = i; j < numeg; j++)
        {
          for (k = 0; k < nblocks; k++)
            {
              top = btop[k];
              djack[k] = top[i * numeg + j];
            }

          mean = gtop[i * numeg + j];
          wjackest (&jest, &jsig, mean, djack, wjack, nblocks);
//    printf("zz %d %d %12.6f %12.6f\n", i, j, mean, jest) ;
          hest[i * numeg + j] = hest[j * numeg + i] = jest;
          hsig[i * numeg + j] = hsig[j * numeg + i] = jsig;
        }
    }

  free (rawcol);
  free (pop0);
  free (pop1);
  free (popall);
  free (gtop);
  free (gbot);
  free (wtop);
  free (wbot);
  free (djack);
  free (wjack);

  free2D (&btop, nblocks);
  free2D (&bbot, nblocks);

}

void
wjackvest (double *vest, double *var, int d, double *mean, double **jmean,
           double *jwt, int g)
// test for jwt 0 
{
  double **jjmean, *jjwt;
  int i, n;

  jjmean = initarray_2Ddouble (g, d, 0.0);
  ZALLOC(jjwt, g, double);

  n = 0;

  for (i = 0; i < g; ++i)
    {
      if (jwt[i] < 1.0e-6)
        continue;
      copyarr (jmean[i], jjmean[n], d);
      jjwt[n] = jwt[i];
      ++n;
    }

  wjackvestx (vest, var, d, mean, jjmean, jjwt, n);

  free2D (&jjmean, g);
  free (jjwt);
}

static
void
wjackvestx (double *vest, double *var, int d, double *mean, double **jmean,
            double *jwt, int g)
// weighted jackknife see wjack.tex
// mean is natural estimate.  jmean[k] mean with block k removed.  jwt is weight for block (sample size)
/** 
 mean is d long 
 jjmean is [g][d]  giving jackknifed estimates after deleting each block  
 jwt  is jackknife weight (weight 0 should be OK but is deprecated 

 Output vest is d long (jackknife estimate) 
 var is error variance 
 */
{

  double *xtau, *hh;
  double *jackest, yn, yvar;
  double *wa;
  int j, k;
  double y1, y2;

  if (g <= 1)
    fatalx ("(wjackvest) not enough blocks\n");

  ZALLOC(hh, g, double);
  ZALLOC(xtau, d, double);
  ZALLOC(wa, d, double);

  jackest = vest;

  vzero (var, d * d);
  vzero (jackest, d);

  yn = asum (jwt, g);

  for (k = 0; k < g; ++k)
    {
      vvm (wa, mean, jmean[k], d);
      vvp (jackest, jackest, wa, d);
      vst (wa, jmean[k], jwt[k] / yn, d);
      vvp (jackest, jackest, wa, d);
    }
// this is equation 2

  vclear (hh, yn, g);

  for (k = 0; k < g; ++k)
    {

      if (jwt[k] > 0.0)
        hh[k] /= jwt[k];
      else
        hh[k] *= 1.0e20;

      y1 = hh[k];
      vst (xtau, mean, y1, d);
      --y1;
      vst (wa, jmean[k], y1, d);
      vvm (xtau, xtau, wa, d);
      vvm (xtau, xtau, jackest, d);
      y2 = 1.0 / sqrt (y1);
      vst (wa, xtau, y2, d);
      addouter (var, wa, d);
    }
// jwt should be positive

  vst (var, var, 1.0 / (double) g, d * d);

  free (hh);
  free (xtau);
  free (wa);

}

int
f3yyx (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows,
       int numeg, Indiv **indm)
{
  int *c1, *c2, *c3, *cc;
  int *rawcol;
  int k, g, i, a, b, c;
  int a0, a1, kret;
  double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;

  int **ccc, *gg, **ccx;
  static int ncall = 0;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);
  ccx = initarray_2Dint (numeg + 1, 2, 0);

  vzero (estmat, numeg * numeg * numeg);

  getrawcolx (ccc, cupt, xindex, nrows, indm);

  for (k = 0; k < nrows; ++k)
    {
      a = xtypes[k];
      if (a < 0)
        continue;
      if (a >= numeg)
        continue;
      g = ccc[k][0];
      if (g < 0)
        continue;
      cc = ccx[a];
      ivvp (cc, cc, ccc[k], 2);
    }

  kret = 1;

  for (a = 0; a < numeg; a++)
    {
      for (b = 0; b < numeg; b++)
        {
          for (c = 0; c < numeg; c++)
            {
              if (a == b)
                continue;
              if (a == c)
                continue;
              if (c < b)
                continue;

              c1 = ccx[a];
              c2 = ccx[b];
              c3 = ccx[c];

              ya = (double) c1[0];
              yb = (double) c1[1];
              z = ya + yb;

              yt = ya + yb;
              if (yt <= 0)
                {
                  kret = -1;
                  break;
                }
              p1 = ya / yt;
              h1 = ya * yb / (yt * (yt - 1.0));

              yaa = (double) c2[0];
              ybb = (double) c2[1];
              yt = yaa + ybb;
              if (yt <= 0)
                {
                  kret = -1;
                  break;
                }
              p2 = yaa / yt;
              h2 = yaa * ybb / (yt * (yt - 1.0));
              zz = yaa + ybb;

              yaa = (double) c3[0];
              ybb = (double) c3[1];
              yt = yaa + ybb;
              if (yt <= 0)
                {
                  kret = -1;
                  break;
                }
              p3 = yaa / yt;

              en = (p1 - p2) * (p1 - p3);
              en -= h1 / z;

              if (b == c)
                en -= h2 / zz;

              bump3 (estmat, a, b, c, numeg, en);
              if (b != c)
                bump3 (estmat, a, c, b, numeg, en);
            }
        }
    }

  free2Dint (&ccc, nrows);
  free2Dint (&ccx, numeg + 1);
  return kret;

}

void
f3yy (double *estmat, SNP *cupt, int *xindex, int *xtypes, int nrows, int numeg)
{
  int *c1, *c2, *c3, *cc;
  int *rawcol;
  int k, g, i, a, b, c;
  double ya, yb, yaa, ybb, p1, p2, p3, en, ed;
  double z, zz, h1, h2, yt;
  double ywt;

  int **ccc, *gg, **ccx;
  static int ncall = 0;

  ++ncall;
  ccc = initarray_2Dint (nrows, 2, 0);
  ccx = initarray_2Dint (numeg, 2, 0);

  vzero (estmat, numeg * numeg * numeg);

  ZALLOC(rawcol, nrows, int);
  getrawcol (rawcol, cupt, xindex, nrows);
  for (a = 0; a < nrows; a++)
    {
      g = rawcol[a];
      ccc[a][0] = g;
      ccc[a][1] = 2 - g;
    }
  free (rawcol);

  for (k = 0; k < nrows; ++k)
    {
      a = xtypes[k];
      if (a < 0)
        continue;
      if (a >= numeg)
        continue;
      g = ccc[k][0];
      if (g < 0)
        continue;
      cc = ccx[a];
      ivvp (cc, cc, ccc[k], 2);
    }

  for (a = 0; a < numeg; a++)
    {
      for (b = 0; b < numeg; b++)
        {
          for (c = 0; c < numeg; c++)
            {
              if (a == b)
                continue;
              if (a == c)
                continue;
              if (c < b)
                continue;

              c1 = ccx[a];
              c2 = ccx[b];
              c3 = ccx[c];

              ya = (double) c1[0];
              yb = (double) c1[1];
              z = ya + yb;

              yt = ya + yb;
              p1 = ya / yt;
              h1 = ya * yb / (yt * (yt - 1.0));

              yaa = (double) c2[0];
              ybb = (double) c2[1];
              yt = yaa + ybb;
              p2 = yaa / yt;
              h2 = yaa * ybb / (yt * (yt - 1.0));
              zz = yaa + ybb;

              yaa = (double) c3[0];
              ybb = (double) c3[1];
              yt = yaa + ybb;
              p3 = yaa / yt;

              en = (p1 - p2) * (p1 - p3);
              en -= h1 / z;

              if (b == c)
                en -= h2 / zz;

              bump3 (estmat, a, b, c, numeg, en);
              if (b != c)
                bump3 (estmat, a, c, b, numeg, en);
            }
        }
    }

  free2Dint (&ccc, nrows);
  free2Dint (&ccx, numeg);

}

double
estmix (double *z, double *f3, int n)

/**
 We minimize 
 {f - \sum_i w_i x_i}^2 where f is a target population or individual and x_i are 
 mixing coefficients.  We can write this as in:  
 {\sum_i w_i (f-x_i)}^2 - \lam (\sum_i w_i -1)  
 which yields equations 
 \sum_j X_{ij} w_j = \lam  
 where X are f_3 or f_2 coefficients.
 We solve this by setting lambda = 1 and then normalizing the answer to sum 
 to 1.
 */
{

  int a, b;
  int d = n - 1;
  double *co, *rhs, y, *ww, *w1;

  ZALLOC(co, d*d, double);
  ZALLOC(ww, d*d, double);
  ZALLOC(rhs, d, double);
  ZALLOC(w1, d, double);

  vclear (rhs, 1.0, d);

  for (a = 0; a < d; a++)
    {
      for (b = a; b < d; b++)
        {

          y = dump3 (f3, 0, a + 1, b + 1, n);
// works if a = b as dof3 fixed up
          co[a * d + b] = co[b * d + a] = y;

        }
    }
  vclear (w1, 1.0, d);
  mulmat (rhs, co, w1, d, d, 1);
  mulmat (ww, co, co, d, d, d);

  solvit (ww, rhs, d, z);

  y = asum (z, d);
  if (y == 0.0)
    fatalx ("z is zero!\n");
  vst (z, z, 1.0 / y, d);

  mulmat (rhs, co, z, d, d, 1);
  y = vdot (z, rhs, d);

  free (co);
  free (rhs);
  free (ww);
  free (w1);

  return y;

}
double
ff3val (double *ff3, int a, int b, int c, int n)
{
  double y;

  y = dump3 (ff3, 0, a, a, n);
  y += dump3 (ff3, 0, b, c, n);
  y -= dump3 (ff3, 0, b, a, n);
  y -= dump3 (ff3, 0, c, a, n);
  return y;

}
void
setinbreed (int val)
{
  inbreed = val;
}
void
calchetinbreed (int *c1, double *phet, double *phetin)
{

  double s, t, a, b, h1, h2, ex, en, ed;
  double x0, x1, x2, y0, y1, y2;

  *phet = *phetin = -1.0;
  s = intsum (c1, 3);
  if (s < 1.5)
    return;
  x0 = c1[0];
  x1 = c1[1];
  x2 = c1[2];
  h1 = x0 * x2 + (x0 + x2) * x1 / 2 + x1 * (x1 - 1) / 4;
  h1 /= (double) (s * (s - 1));
  *phet = 2 * h1;
  *phetin = x1 / (double) s;  //naive estimate, unbiased
}

void
calcndinbreed (int *c1, int *c2, double *pen, double *ped)
{

  double s, t, a, b, h1, h2, ex, en, ed;
  double x0, x1, x2, y0, y1, y2;

  *pen = *ped = -1.0;
  s = intsum (c1, 3);
  t = intsum (c2, 3);
  if (s < 1.5)
    return;
  if (t < 1.5)
    return;
  x0 = c1[0];
  x1 = c1[1];
  x2 = c1[2];
  y0 = c2[0];
  y1 = c2[1];
  y2 = c2[2];
  a = (x1 + 2 * x2) / (2 * s);
  b = (y1 + 2 * y2) / (2 * t);
  ex = (a - b) * (a - b);
  ex += x1 / (4 * s * s);
  ex += y1 / (4 * t * t);
  h1 = x0 * x2 + (x0 + x2) * x1 / 2 + x1 * (x1 - 1) / 4;
  h2 = y0 * y2 + (y0 + y2) * y1 / 2 + y1 * (y1 - 1) / 4;
  h1 /= (double) s * (s - 1);
  h2 /= (double) t * (t - 1);
  en = ex - (h1 / s + h2 / t);
  ed = en + h1 + h2;
  *pen = en;
  *ped = ed;
}

