#include <stdio.h>
#include <string.h>
#include <math.h>
#include "chaincolln.h"
#include "cokus.h"
#include "chain.h"
#include "config.h"
#include "parameters.h"
#include "irmutils.h"
#include "relation.h"
#include "domain.h"

#ifdef GSL
#include <gsl/gsl_randist.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_rng.h>
#endif

/*****************************************************************************
A collection of chains. We maintain several chains in case we want to run
Metropolis-coupled MCMC (MC^3). We also keep one spare chain so that
split-merge proposals can be tried without losing the current state.
*****************************************************************************/

struct chaincolln_str
{ int nchains;
  chain *chains;
  chain sparechain;
  char prefix[MAXSTRING];	/* unused right now */
  int itercount;		/* iteration count */
} chaincolln_str;

/* nchains already includes one extra for sparechain */
chaincolln chaincolln_create(int nchains, int ndomains, int nrelns, char *pref)
{
  int i;
  chaincolln cc;
  double temp;
  cc  = (chaincolln) my_malloc(sizeof(struct chaincolln_str));
  cc->chains = (chain *) my_malloc(nchains*sizeof(chain ));
  /* include spare chain */
  for (i = 0; i < nchains; i++) {
    temp = 1.0/(1+ps.temp*i);
    cc->chains[i] = chain_create(ndomains, nrelns, temp);
  }
  cc->nchains = nchains-1;
  cc->sparechain = cc->chains[nchains-1];
  strcpy(cc->prefix, pref);
  cc->itercount = 0;
  return cc;
}

/* read the configuration file and the graph */
chaincolln chaincolln_readdata(void) {
  FILE *fileptr, *initzsfile;
  int i, j, k, ndom, nreln, d, r, nitem, dim, maxclass, initclass, relcl, ndim,
	domlabel, clusterflag, itemind, nchains, cind, zind;
  int *domlabels, *participants, participant;
  double val;
  double nig[DISTSIZE];
  domain *doms;
  relation rn;
  int *initclasses, ***edgecounts, *relsizes;
  char prefix[MAXSTRING];

  chaincolln cc;
  chain c, c0;
#ifdef GSL
  gsl_rng *rng;
  const gsl_rng_type *T;
  gsl_permutation *perm ;
  size_t N;

  gsl_rng_env_setup();
  T = gsl_rng_default;
  rng = gsl_rng_alloc(T);
#endif

  fprintf(stdout,"A\n");
  nchains = ps.nchains+1;
  nig[0] = ps.m; nig[1] = ps.v; nig[2] = ps.a; nig[3] = ps.b;

  fileptr = fopen(ps.configfile,"r");
  if (fileptr == NULL) {
    fprintf(stderr, "couldn't read config file\n"); exit(1);
  }

  /* initial read of ps.configfile to get ps.maxdim, ps.maxrel, ps.maxitem,
     ps.maxclass */
  fscanf(fileptr, "%s", prefix);
  fscanf(fileptr, "%d %d", &ndom, &nreln);
  relsizes=  (int *) my_malloc(nreln*sizeof(int));
  ps.maxrel = nreln;
  ps.maxitem = 0; ps.maxclass = 0;
  for (d = 0; d < ndom; d++) {
    fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
    if (nitem > ps.maxitem) {
      ps.maxitem = nitem;
    }
    if (maxclass > ps.maxclass) {
      ps.maxclass= maxclass;
    }
  }
  fprintf(stdout,"B\n");
  ps.maxdim = 0;
  for (r = 0; r < nreln; r++) {
    fscanf(fileptr, "%d", &ndim);
    relsizes[r] = ndim;
    if (ndim > ps.maxdim) {
      ps.maxdim = ndim;
    }
    for (dim=0; dim < ndim; dim++) {
      fscanf(fileptr, "%d", &domlabel);
    }
  }
  fclose(fileptr);

  fprintf(stdout,"C\n");
  domlabels=	 (int *) my_malloc(ps.maxdim*sizeof(int));
  participants=  (int *) my_malloc(ps.maxdim*sizeof(int));
  initclasses =  (int *) my_malloc(ps.maxitem*sizeof(int));

  fprintf(stdout,"D \n");
  /* initial read of ps.graphname to get ps.maxobjtuples */
  edgecounts =  (int ***) my_malloc(ps.maxrel*sizeof(int **));
  for (i = 0; i < ps.maxrel; i++) {
    edgecounts[i] =  (int **) my_malloc(ps.maxdim*sizeof(int *));
    for (j = 0; j < ps.maxdim; j++) {
      edgecounts[i][j] =  (int *) my_malloc(ps.maxitem*sizeof(int));
      for (k = 0; k < ps.maxitem; k++) {
        edgecounts[i][j][k] = 0;
      }
    }
  }
  ps.maxobjtuples = 0;

  fprintf(stdout,"D2 \n");
  fileptr = fopen(ps.graphname,"r");
  if (fileptr == NULL) {
    fprintf(stderr, "couldn't read graph\n"); exit(1);
  }
  while( fscanf( fileptr, " %d", &r)!=EOF ) {
    fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,r);
    ndim = relsizes[r];
    fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,ndim);
    for (dim = 0; dim < ndim; dim++) {
      fscanf(fileptr, "%d", &participant);
      participants[dim] = participant;
    }
    fscanf(fileptr, "%lf", &val);

    for (dim = 0; dim < ndim; dim++) {
      fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
        edgecounts[r][dim][participants[dim]]++;
      fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
    }
  }
  fprintf(stdout,"E\n");
  fclose(fileptr);
  for (i = 0; i < ps.maxrel; i++) {
    for (j = 0; j < ps.maxdim; j++) {
      for (k = 0; k < ps.maxitem; k++) {
        if (edgecounts[i][j][k] > ps.maxobjtuples) {
          ps.maxobjtuples = edgecounts[i][j][k];
        }
        edgecounts[i][j][k]= 0;
      }
    }
  }

  fprintf(stdout,"F\n");
  free(relsizes);
  for (i = 0; i < ps.maxrel; i++) {
    for (j = 0; j < ps.maxdim; j++) {
      free(edgecounts[i][j]);
    }
    free(edgecounts[i]);
  }
  free(edgecounts);

  fprintf(stdout,"G\n");
  /* second read of ps.configfile where we set up datastructures */

  fileptr = fopen(ps.configfile,"r");
  if (ps.outsideinit) {
    initzsfile= fopen(ps.initfile,"r");
    if (initzsfile == NULL) {
      fprintf(stderr, "couldn't read initzsfile\n"); exit(1);
    }
  } else {
    initzsfile = NULL;
  }

  fprintf(stdout,"H\n");
  fscanf(fileptr, "%s", prefix);
  fscanf(fileptr, "%d %d", &ndom, &nreln);

  cc = chaincolln_create(nchains, ndom, nreln, prefix);
  c0 = chaincolln_getchain(cc, 0);

  fprintf(stdout,"I\n");
  /* read domains */
  /* input file: nitem maxclass initclass clusterflag*/
  for (d = 0; d < ndom; d++) {
    fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
#ifdef GSL
    N = nitem;
#endif
    if (ps.outsideinit) {
      for (zind = 0; zind < nitem; zind++) {
        fscanf(initzsfile, "%d", &initclasses[zind]);
      }
    }
  fprintf(stdout,"J\n");

    /* add domains and items to chains */
    for (cind = 0; cind < nchains; cind++) {
      c = chaincolln_getchain(cc, cind);
      chain_adddomain(c, d, nitem, maxclass, clusterflag, ps.alpha,
		      ps.alphahyp, initclasses);
#ifdef GSL
      perm =  gsl_permutation_alloc(N);
      gsl_permutation_init(perm);
      gsl_ran_shuffle(rng, perm->data, N, sizeof(size_t));
#endif
      /* assign items to classes */
      relcl = 0;
      for (i = 0; i < nitem; i++) {
        if (ps.outsideinit) {
	  chain_additemtoclass(c, d, i, initclasses[i]);
	} else {
          if (relcl == initclass) relcl = 0;

	  /* without the GNUSL, each chain gets initialized the same way. This
	   * is suboptimal */
	  itemind = i;
#ifdef GSL
          itemind = gsl_permutation_get(perm, i);
#endif
          chain_additemtoclass(c, d, itemind, relcl);
          relcl++;
        }
      }
#ifdef GSL
      gsl_permutation_free(perm);
#endif
    }
  }
#ifdef GSL
  gsl_rng_free(rng);
#endif

  fprintf(stdout,"K\n");
  /* read relations*/
  /* input file: ndim d0 ... dn */

  for (r = 0; r < nreln; r++) {
    fscanf(fileptr, "%d", &ndim);
    for (dim=0; dim < ndim; dim++) {
      fscanf(fileptr, "%d", &domlabel);
      domlabels[dim] = domlabel;
    }
    for (cind = 0; cind < nchains; cind++) {
      c = chaincolln_getchain(cc, cind);
      chain_addrelation(c, r, ndim, ps.betaprop, ps.betamag, nig, domlabels);
    }
  }
  if (ps.outsideinit) {
    fclose(initzsfile);
  }

  fprintf(stdout,"L\n");
  fclose(fileptr);
  /* second read of ps.graphname: store edges*/
  fileptr = fopen(ps.graphname,"r");
  /* input file: relind p0 p1 p2 .. pn val */
  while( fscanf( fileptr, " %d", &r)!= EOF ) {
    ndim = relation_getdim( chain_getrelation(c0, r) );
    doms = relation_getdoms( chain_getrelation(c0, r) );
    for (dim = 0; dim < ndim; dim++) {
      fscanf(fileptr, "%d", &participant);
      fprintf(stdout,"M %d %d\n",dim,participant);
      participants[dim] = participant;
      domlabels[dim] = domain_getlabel(doms[dim]);
    }

    for (i = 0; i < ndim; i++) {
      for (j = 0; j < i; j++) {
        if (participants[i] == participants[j] &&
	    domlabels[i] == domlabels[j]) {
	  fprintf(stderr, "Self links not allowed.\n"); exit(1);
	}
      }
    }

    fscanf(fileptr, "%lf", &val);
      fprintf(stderr,"%d\n",nchains);
    for (cind = 0; cind < nchains; cind++) {
      c = chaincolln_getchain(cc, cind);
      chain_addedge(c, r, val, participants);

      rn = chain_getrelation(c, r);

      if (doubleeq(val, 0)) {
	relation_setmissing(rn, 1);
      }

      if (val > 1.5 && relation_getdtype(rn) != CONT) {
	relation_setdtype(rn, FREQ);
      }

      if (!doubleeq(val, (int) val)) {
	relation_setdtype(rn, CONT);
	relation_setmissing(rn, 1); /* XXX: no sparse continuous matrices */
      }

    }
  }

  fprintf(stderr,"N\n");
  fclose(fileptr);

  for (cind = 0; cind < nchains; cind++) {
    c = chaincolln_getchain(cc, cind);
    for (i = 0; i < chain_getndomains(c); i++) {
      chain_updatedomprobs(c, i);
    }
  }

  fprintf(stderr,"O\n");
  free(domlabels); free(participants); free(initclasses);

  return cc;
}

int chaincolln_getnchain(chaincolln cc) {
  return cc->nchains;
}

chain chaincolln_getchain(chaincolln cc, int chainind) {
  return cc->chains[chainind];
}

char *chaincolln_getprefix(chaincolln cc) {
  return cc->prefix;
}

int chaincolln_getitercount(chaincolln cc) {
  return cc->itercount;
}

void chaincolln_print(chaincolln cc) {
  chaincolln_printassignments(cc);
  chaincolln_printstatus(cc, NULL);
  chaincolln_printstatus(cc, stderr);
}

/* run hillclimbing with random restarts */
void chaincolln_climb(chaincolln cc, int maxloops) {
  int i, j, changeflag, nrepeats;
  chain chn, schn;
  double oldscore, newscore, currscore;

  chn = chaincolln_getchain(cc, 0);
  schn = cc->sparechain;
  changeflag = 1;
  nrepeats = 0;
  oldscore = -MAXDOUBLE;
  currscore= -MAXDOUBLE;

  chaincolln_print(cc);
  for (i = 0; i < maxloops; i++) {
    if (changeflag > 0) {
      /* maximizing scan: move each object to the best class for it */
      changeflag = chain_climbscan(chn);
    }
    /*chain_print(chn); fprintf(stderr, "splitting\n");*/
    changeflag = changeflag + chain_climbsplitfast(chn, schn);

    /*chain_print(chn); fprintf(stderr, "merging\n");*/
    changeflag = changeflag + chain_climbmergefast(chn, schn);

    for (j = 0; j < ps.hypupdates; j++) {
      changeflag = changeflag + chaincolln_hypupdates(cc, &proposal_best);
    }

    cc->itercount++;
    newscore = chain_getprob(chn);
    if ( fabs(newscore - oldscore) < 0.00001 * fabs(newscore) ) {
      nrepeats++;
      if (nrepeats == 8) {
        chaincolln_print(cc);
        fprintf(stderr, "*************** randomize\n");
        nrepeats = 0;
	chain_randomize(cc->chains[0]);
        currscore = chain_getprob(chn);
        newscore = chain_getprob(chn);
      }
    } else {
      nrepeats = 0;
    }
    oldscore = newscore;
    chaincolln_printstatus(cc, stderr);
  }
}

/* run gibbs sampler with Metropolis updates (MC^3, split-merge) */
void chaincolln_mcmc(chaincolln cc, int maxloops) {
  int i, j;
  chaincolln_print(cc);
  for (i = 0; i < maxloops; i++) {
    fprintf(stderr,"loop %d",i);
    /* gibbs scans and split merge updates */
    chaincolln_sample(cc, 1);
    /* MC^3: try swaps between chains at different temperatures */
    chaincolln_tryswaps(cc);
    /* hyperparameter updates? */
    for (j = 0; j < ps.hypupdates; j++) {
      chaincolln_hypupdates(cc, &proposal_mcmc);
    }
    chaincolln_print(cc);
  }
}

/* update hyperparameters */
int chaincolln_hypupdates(chaincolln cc,
	int (*proposal_choose) (double, double, double)) {
  int i, changeflag;
  changeflag = 0;
  for (i = 0; i < cc->nchains; i++) {
    chain_hypupdate(chaincolln_getchain(cc, i), proposal_choose, &changeflag);
  }
  return changeflag;
}

void chaincolln_itergibbsm(chaincolln cc) {
  int i;
  if (1) { /* regular gibbs scans */
    for (i = 0; i < cc->nchains; i++) {
      chain_itergibbs(chaincolln_getchain(cc, i));
    }
  }
  if (1) { /* split-merge updates */
    for (i = 0; i < cc->nchains; i++) {
      chain_itersm(chaincolln_getchain(cc, i), cc->sparechain);
    }
  }
  cc->itercount++;
}

void chaincolln_sample(chaincolln cc, int niter) {
  int i;
  for (i = 0; i < niter; i++) {
    chaincolln_itergibbsm(cc);
  }
}

/* try swapping chains at different temperatures */
void chaincolln_tryswaps(chaincolln cc) {
  int nchains;
  int sw1, sw2, swcount;
  chain c1, c2;
  double t1, t2, aswap, rn;

  nchains = cc->nchains;
  if (nchains > 1) {
    for (swcount = 0; swcount < 1; swcount++) {
      sw1 = randomitem(nchains);
      sw2 = sw1;
      while (sw2 == sw1) { sw2 = randomitem(nchains); }

      c1 = cc->chains[sw1]; c2 = cc->chains[sw2];
      t1 = chain_gettemp(c1); t2 = chain_gettemp(c2);
      aswap = exp( (t1 - t2)* (chain_getprob(c2) - chain_getprob(c1)) );
      if (aswap > 1) { aswap=1; }
      rn = myrand();
      if (rn < aswap) {
        chaincolln_swapchains(cc, sw1, sw2);
        fprintf(stderr, "****CS: %f\n", aswap);
      }
    }
  }
}

/* swap chains SW1 and SW2 */
void chaincolln_swapchains(chaincolln cc, int sw1, int sw2) {
  chain c1, c2;
  double t1, t2;
  c1 = chaincolln_getchain(cc, sw1);
  c2 = chaincolln_getchain(cc, sw2);
  t1 = chain_gettemp(c1); t2 = chain_gettemp(c2);
  chain_settemp(c1, t2); chain_settemp(c2, t1);
  cc->chains[sw1] = c2;
  cc->chains[sw2] = c1;
}

void chaincolln_printassignments(chaincolln cc) {
  int i;
  chain chn;
  char filename[MAXSTRING];
  FILE * domfileptr;

  chn = chaincolln_getchain(cc, 0);
  for (i = 0; i < chain_getndomains(chn); i++) {
    sprintf(filename, "%s_dom%d", ps.outroot, i);
    domfileptr = fopen(filename, "a");
    if (domfileptr == NULL) {
      fprintf(stderr, "couldn't read domain file\n");
      exit(1);
    }
    domain_printassignments(domfileptr, chain_getdomain(chn, i));
    fclose(domfileptr);
  }
}

void chaincolln_printstatus(chaincolln cc, FILE *fptr) {
  int i, nchains;
  chain chn;
  char filename[MAXSTRING];
  FILE * domfileptr;

  nchains = chaincolln_getnchain(cc);
  if (fptr == NULL) {
    sprintf(filename, "%s_status", ps.outroot);
    domfileptr = fopen(filename, "a");
    if (domfileptr == NULL) {
      fprintf(stderr, "couldn't read statusfile\n");
      exit(1);
    }
  } else {
    domfileptr = fptr;
  }
  fprintf(domfileptr, "%4d: ", chaincolln_getitercount(cc));
  chn = chaincolln_getchain(cc, 0);
  chain_printdetailedstatus(chn, domfileptr);
  for (i = 1; i < nchains; i++) {
    chn = chaincolln_getchain(cc, i);
    chain_printbriefstatus(chn, domfileptr);
  }
  chn = chaincolln_getchain(cc,0);
  chain_printhyps(chn, domfileptr);
  fprintf(domfileptr, "\n");

  if (fptr == NULL) {
    fclose(domfileptr);
  }
}

void chaincolln_free(chaincolln cc)
{
  int i;
  /* include spare chain */
  for (i = 0; i < cc->nchains+1; i++) {
    chain_free(cc->chains[i]);
  }
  free(cc->chains);
  free(cc);
}


/* $Id$         */
/*--------------------------------------------------------------------*/
/*;  Copyright (C) 2003-2013                                          */
/*;  Associated Universities, Inc. Washington DC, USA.                */
/*;                                                                   */
/*;  This program is free software; you can redistribute it and/or    */
/*;  modify it under the terms of the GNU General Public License as   */
/*;  published by the Free Software Foundation; either version 2 of   */
/*;  the License, or (at your option) any later version.              */
/*;                                                                   */
/*;  This program is distributed in the hope that it will be useful,  */
/*;  but WITHOUT ANY WARRANTY; without even the implied warranty of   */
/*;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the    */
/*;  GNU General Public License for more details.                     */
/*;                                                                   */
/*;  You should have received a copy of the GNU General Public        */
/*;  License along with this program; if not, write to the Free       */
/*;  Software Foundation, Inc., 675 Massachusetts Ave, Cambridge,     */
/*;  MA 02139, USA.                                                   */
/*;                                                                   */
/*;Correspondence about this software should be addressed as follows: */
/*;         Internet email: bcotton@nrao.edu.                         */
/*;         Postal address: William Cotton                            */
/*;                         National Radio Astronomy Observatory      */
/*;                         520 Edgemont Road                         */
/*;                         Charlottesville, VA 22903-2475 USA        */
/*--------------------------------------------------------------------*/
#ifndef OBITFFT_H
#define OBITFFT_H

/* FFTW3 ?  */
#if HAVE_FFTW3==1
#include <fftw3.h>
#elif HAVE_FFTW==1  /* else Try FFTW 2 */
#include <fftw.h>
#include <rfftw.h>
#elif HAVE_GSL==1  /* Else try GSL version */
#include <gsl/gsl_fft_complex_float.h>
#include <gsl/gsl_fft_halfcomplex_float.h>
#include <gsl/gsl_fft_real_float.h>
#include <gsl/gsl_fft_complex.h>
#include <gsl/gsl_fft_halfcomplex.h>
#include <gsl/gsl_fft_real.h>
#endif /* HAVE_GSL */
#include "Obit.h"
#include "ObitThread.h"
#include "ObitFArray.h"
#include "ObitCArray.h"

/*-------- Obit: Merx mollis mortibus nuper ------------------*/
/**
 * \file ObitFFT.h
 * ObitFFT Fast Fourier Transform class definition.
 *
 * This class is derived from the #Obit class.
 *
 * This class is for performing FFT on memory resident data.
 * This implementation uses the FFTW package if available, else gsl
 *
 * \section FFTOrder  Data order
 * Data passed to and from ObitFFT routines are as an ObitFArray or ObitCArray
 * which are stored in column major (Fortran) order.
 * Data are passed and returned in "center-at-the-edge" (i.e. unnatural) order
 * and there is NO transpose of the array axes.
 * In the half complex form, the first axis is nx/2+1 where nx is the number of
 * real elements.
 * Only even numbers of elements on each axis will work well.
 *
 * \section ObitFFTaccess Creators and Destructors
 * An ObitFFT can be created using newObitFFT which allows specifying
 * a name for the object, and the type, size and direction of the transform.
 *
 * A copy of a pointer to an ObitFFT should always be made using the
 * #ObitFFTRef function which updates the reference count in the object.
 * Then whenever freeing an ObitFFT or changing a pointer, the function
 * #ObitFFTUnref will decrement the reference count and destroy the object
 * when the reference count hits 0.
 * There is no explicit destructor.
 *
 * \section Multi-threaded operation
 * If this module is compiled with the -DHAVE_FFTW3THREADS==1 option
 * and linked with the -lfftw3f_threads option, multithreaded operation
 * is enabled.
 * NOTE: this should NOT be used inside ObitThreads as the threading will
 * collide.
 * The maximum number of threads to be used in subsequent ObitFFT objects is
 * set using #ObitFFTNThreads; setting nThreads to 1 turns off threading.
 * After all ObitFFT objects are destroyed, calling #ObitFFTClearThreads
 * will clean up after the threading.
 */

/*-------------- enumerations -------------------------------------*/
/**
 * \enum ObitFFTdir
 * enum for FFT direction
 * This specifies the status of the connection a disk resident data.
 */
enum obitFFTdir {
  /** Sign of exponent in transform = -1, real to complex */
  OBIT_FFT_Forward,
  /** Sign of exponent in transform = +1, complex to real  */
  OBIT_FFT_Reverse
}; /* end enum obitFFTdir */
/** typedef for enum for ObitIO object status. */
typedef enum obitFFTdir ObitFFTdir;

/**
 * \enum ObitFFTtype
 * enum for FFT type, complex to complex or real to complex/
 * This specifies the status of the connection a disk resident data.
 */
enum obitFFTtype {
  /** Full complex to complex transforms */
  OBIT_FFT_FullComplex,
  /** Real to half complex or reverse.  */
  OBIT_FFT_HalfComplex
}; /* end enum obitFFTtype */
/** typedef for enum for ObitIO object status. */
typedef enum obitFFTtype ObitFFTtype;

/*--------------Class definitions-------------------------------------*/
/** ObitFFT Class structure. */
typedef struct {
#include "ObitFFTDef.h"   /* this class definition */
} ObitFFT;

/*----------------- Macroes ---------------------------*/
/**
 * Macro to unreference (and possibly destroy) an ObitFFT
 * returns a ObitFFT*.
 * in = object to unreference
 */
#define ObitFFTUnref(in) ObitUnref (in)

/**
 * Macro to reference (update reference count) an ObitFFT.
 * returns a ObitFFT*.
 * in = object to reference
 */
#define ObitFFTRef(in) ObitRef (in)

/**
 * Macro to determine if an object is the member of this or a
 * derived class.
 * Returns TRUE if a member, else FALSE
 * in = object to reference
 */
#define ObitFFTIsA(in) ObitIsA (in, ObitFFTGetClass())

/*---------------Public functions---------------------------*/
/** Public: Class initializer. */
void ObitFFTClassInit (void);

/** Public: Constructor. */
ObitFFT* newObitFFT (gchar* name, ObitFFTdir dir, ObitFFTtype type,
		     olong rank, olong *dim);
/** Typedef for definition of class pointer structure */
typedef ObitFFT* (*newObitFFTFP) (gchar *name, ObitFFTdir dir,
				  ObitFFTtype type,
				  olong rank, olong *dim);

/** Public: ClassInfo pointer */
gconstpointer ObitFFTGetClass (void);

/** Public: Suggest efficient size for a transform */
olong ObitFFTSuggestSize (olong length);

/** Public: Enable threading */
void ObitFFTNThreads (olong nThreads);

/** Public: Cleanup threading */
void ObitFFTClearThreads (void);

/** Public: Real to half Complex. */
void ObitFFTR2C (ObitFFT *in, ObitFArray *inArray, ObitCArray *outArray);
typedef void (*ObitFFTR2CFP) (ObitFFT *in, ObitFArray *inArray,
			    ObitCArray *outArray);

/** Public: Half Complex to Real. */
void ObitFFTC2R (ObitFFT *in, ObitCArray *inArray, ObitFArray *outArray);
typedef void (*ObitFFTC2RFP) (ObitFFT *in, ObitCArray *inArray,
			    ObitFArray *outArray);

/** Public: Full Complex to Complex. */
void ObitFFTC2C (ObitFFT *in, ObitCArray *inArray, ObitCArray *outArray);
typedef void (*ObitFFTC2CFP) (ObitFFT *in, ObitCArray *inArray,
			    ObitCArray *outArray);

/*----------- ClassInfo Structure -----------------------------------*/
/**
 * ClassInfo Structure.
 * Contains class name, a pointer to any parent class
 * (NULL if none) and function pointers.
 */
typedef struct  {
#include "ObitFFTClassDef.h"
} ObitFFTClassInfo;

#endif /* OBITFFT_H */


/* DomSelfAdaptFWD.c

Forward-in-time simulation of an adaptive alleles with dominance and selfing, with linked neutral fragment.

This is the BATCH version - to be used on cluster machine to produce many simulation replicates at once.

Burn-in program: generates neutral background diversity for other simulations to use. See README for more information.

Simulation uses routines found with the GNU Scientific Library (GSL)
(http://www.gnu.org/software/gsl/)
Since GSL is distributed under the GNU General Public License
(http://www.gnu.org/copyleft/gpl.html), you must download it
separately from this file.

*/

/* Preprocessor statements */
#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <math.h>
#include <stddef.h>
#include <string.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <sys/stat.h>
#include <sys/types.h>

#define INITTS 1000

/* Function prototypes */
void Wait();
unsigned int bitswitch(unsigned int x);
void generation_BI(unsigned int N, double self, double R, unsigned int *nums, unsigned int **neutin, unsigned int **neutout, unsigned int npoly, double *polypos, const gsl_rng *r);
void rec_sort(double *index, unsigned int nrow);
void addpoly(unsigned int N, unsigned int **neutin, double *polyloc, unsigned int *npoly, double theta, const gsl_rng *r);
void reassign2(unsigned int **neutin, unsigned int **neutout, double *posin, double *posout, unsigned int npoly, unsigned int N, unsigned int aft);
void popprint(unsigned int **neutin, double *posin, unsigned int npoly, unsigned int N, unsigned int ei, unsigned int suffix);
void polyprint(unsigned int **neutin, double *posin, unsigned int npoly, unsigned int N);
void ptrim(unsigned int size, unsigned int **neutin, unsigned int **neutout, double *posin, double *posout, unsigned int npoly, unsigned int *npolyT, double *avpi);
unsigned int uniqueH(unsigned int **neutin, unsigned int npoly, unsigned int N);

void Wait(){
	printf("Press Enter to Continue");
	while( getchar() != '\n' );
	printf("\n");
}

/* Bit-switching routine */
unsigned int bitswitch(unsigned int x){
	unsigned int ret;
	switch(x)
	{
		case 0:
			ret = 1;
			break;
		case 1:
			ret = 0;
			break;
		default:	/* If none of these cases chosen, exit with error message */
			fprintf(stderr,"Error in bitswitch: input is not 0 or 1.\n");
			exit(1);
            break;
	}
	return ret;
}

/* Sorting rec events after choosing them */
void rec_sort(double *index, unsigned int nrow){
	unsigned int j, i;		/* Sorting indices */
	double temp0;		/* For swapping */

	for(j = 1; j < nrow; j++){
		i = j;
		while( (i > 0) && ( *(index + (i - 1) ) > *(index + i) )){
			/* Swapping entries */
			temp0 = *(index + (i - 1));
			*(index + (i - 1)) =  *(index + (i));
			*(index + (i)) = temp0;
			i--;
		}
	}

}

/* Reproduction routine */
void generation_BI(unsigned int N, double self, double R, unsigned int *nums, unsigned int **neutin, unsigned int **neutout, unsigned int npoly, double *polypos, const gsl_rng *r){
	unsigned int i, j, k;		/* Pop counter, neutral marker counter, rec event counter */
	unsigned int isself = 0;	/* Is this a selfing reproduction? */
	unsigned int choose1 = 0;	/* Chromosome to be selected */
	unsigned int choose2 = 0;	/* Chromosome to be selected (2nd with outcrossing) */
	unsigned int wc1 = 0;		/* Which chrom (parent 1) */
	unsigned int wc2 = 0;		/* Which chrom (parent 2) */
	unsigned int index1 = 0;	/* Index of chosen sample 1 */
	unsigned int index2 = 0;	/* Index of chosen sample 2 */
	unsigned int nself = 0;		/* Number of selfing events */
	unsigned int selfix = 0;	/* Selfing index */
	unsigned int recix1 = 0;	/* Rec index chr 1 */
	unsigned int recix2 = 0;	/* Rec index chr 2 */
	unsigned int nrec1 = 0;		/* Number rec events chr 1 */
	unsigned int nrec2 = 0;		/* Number rec events chr 2 */

	/* First deciding number of selfing events; creating vector of events + choosing */
	nself = gsl_ran_binomial(r, self, N);
	unsigned int *selfev = calloc(nself,sizeof(unsigned int));
	gsl_ran_choose(r, selfev, nself, nums, N, sizeof(unsigned int));

	for(i = 0; i < N; i++){		/* Regenerating population */

    	/* Choosing first parent, and relevant chromosomes */
    	/* ADJUSTED SO PURELY NEUTRAL SELECTION ONLY */
		choose1 = gsl_rng_uniform_int(r,N);
		wc1 = gsl_ran_bernoulli(r,0.5);
		wc2 = gsl_ran_bernoulli(r,0.5);
		index1 = 2*choose1 + wc1;

		/* Copying over selected sites, first checking if selfing occurs */
		isself = 0;
		if(nself != 0){
			if(*(selfev + selfix) == i){
				isself = 1;
				selfix++;
			}
		}
		if(isself == 1){
			index2 = 2*choose1 + wc2;
		}else if(isself == 0){
			choose2 = gsl_rng_uniform_int(r,N);
			index2 = 2*choose2 + wc2;
		}

		/* Now copying over neutral fragment, accounting for recombination */
		if(R != 0){
			/* Choosing number of recombination events on arms 1, 2 */
			recix1 = 0;
			recix2 = 0;
			nrec1 = gsl_ran_poisson(r,R);
			nrec2 = gsl_ran_poisson(r,R);
			double *recev1 = calloc(nrec1 + 1,sizeof(double));
			double *recev2 = calloc(nrec2 + 1,sizeof(double));
			for(k = 0; k < nrec1; k++){
				*(recev1 + k) = gsl_ran_flat(r,0,1);
			}
			for(k = 0; k < nrec2; k++){
				*(recev2 + k) = gsl_ran_flat(r,0,1);
			}
			*(recev1 + nrec1) = 1.01;
			*(recev2 + nrec2) = 1.01;
			rec_sort(recev1,nrec1 + 1);
			rec_sort(recev2,nrec2 + 1);

			for(j = 0; j < npoly; j++){
				if( (*(polypos + j)) >= *(recev1 + recix1)){
					wc1 = bitswitch(wc1);
					index1 = 2*choose1 + wc1;
					recix1++;
				}
				if( (*(polypos + j)) >= *(recev2 + recix2)){
					wc2 = bitswitch(wc2);
					if(isself == 1){
						index2 = 2*choose1 + wc2;
					}else if(isself == 0){
						index2 = 2*choose2 + wc2;
					}
					recix2++;
				}

				*((*(neutout + 2*i)) + j) = *((*(neutin + index1)) + j);
				*((*(neutout + 2*i + 1)) + j) = *((*(neutin + index2)) + j);

			}

			free(recev1);
			free(recev2);

		}else if (R == 0){
			for(j = 0; j < npoly; j++){
				*((*(neutout + 2*i)) + j) = *((*(neutin + index1)) + j);
				*((*(neutout + 2*i + 1)) + j) = *((*(neutin + index2)) + j);
			}
		}
	}

	free(selfev);

}	/* End of reproduction routine */

/* Adding neutral polymorphism routine */
void addpoly(unsigned int N, unsigned int **neutin, double *polyloc, unsigned int *npoly, double theta, const gsl_rng *r){
	unsigned int i, j;
	int k;
	unsigned int newpoly = 0;			/* Number of new polymorphisms added */
	unsigned int pchr = 0;				/* Chromosome of appearance */
	unsigned int pfound = 0;			/* Flag to denote if right index found */
	double ploc = 0;					/* Location of polymorphism */
/*	FILE *ofp_poly;				 Pointer for polymorphisms output */

	newpoly = gsl_ran_poisson(r,(0.5*theta));
/*	printf("Add %d new polymorphisms\n",newpoly);*/

	for(j = 0; j < newpoly; j++){
		ploc = gsl_ran_flat(r,0.0,1.0);
/*		printf("ploc is %lf\n",ploc);	*/
		pchr = gsl_rng_uniform_int(r,2*N);
/*		printf("pchr is %d\n",pchr);*/

		/* Inserting new polymorphism */
		if(*(npoly) == 0){
/*			printf("zero entry here\n");	*/
			*(polyloc + 0) = ploc;
				for(i = 0; i < 2*N; i++){
					*((*(neutin + i)) + 0) = 0;
				}
			*((*(neutin + pchr)) + 0) = 1;
		}else if(*(npoly) > 0){
/*			printf("non-zero entry here\n");		*/
			pfound = 0;
			for(k = (*(npoly) - 1); k >= 0; k--){
/*				printf("k is %d\n",k);*/
				if(*(polyloc + k) > ploc){
/*					printf("is here 1\n");*/
					*(polyloc + k + 1) = *(polyloc + k);
					for(i = 0; i < 2*N; i++){
						*((*(neutin + i)) + k + 1) = *((*(neutin + i)) + k);
					}
				}else if(*(polyloc + k) <= ploc){
/*					printf("is here 2\n");				*/
					pfound = 1;
					*(polyloc + k + 1) = ploc;
					for(i = 0; i < 2*N; i++){
						*((*(neutin + i)) + k + 1) = 0;
					}
					*((*(neutin + pchr)) + k + 1) = 1;
					break;
				}
			}

			if(pfound == 0){		/* In this case polymorphism is inserted at the start */
				*(polyloc + 0) = ploc;
				for(i = 0; i < 2*N; i++){
					*((*(neutin + i)) + 0) = 0;
				}
				*((*(neutin + pchr)) + 0) = 1;
			}

		}

		*(npoly) += 1;
/*		printf("n poly is %d\n",*(npoly));			*/
		if(*(npoly) == INITTS){
			fprintf(stderr,"Too many neutral polymorphisms.\n");
			exit(1);
		}

	}
}

/* Reassigning new population routine (after trimming) */
void reassign2(unsigned int **neutin, unsigned int **neutout, double *posin, double *posout, unsigned int npoly, unsigned int N, unsigned int aft){
	unsigned int i, j;		/* pop counter, poly counter */

	for(i = 0; i < 2*N; i++){
		for(j = 0; j < npoly; j++){
			*((*(neutout + i)) + j) = *((*(neutin + i)) + j);
			if(i == 0 && aft == 1){
				*(posout + j) = *(posin + j);
			}
		}
	}

}	/* End of reassignment routine */

/* Printing population state to file */
void popprint(unsigned int **neutin, double *posin, unsigned int npoly, unsigned int N, unsigned int ei, unsigned int suffix){
	unsigned int i, j;		/* pop counter, poly counter */
	char Pout[32];				 /* String to hold filename in (Mutations) */
	FILE *ofp_poly = NULL;		 /* Pointer for data output */

	/* Printing out polymorphism table */
	sprintf(Pout,"Pop_%d.dat",ei + suffix);
	ofp_poly = fopen(Pout,"w");
	for(j = 0; j < npoly; j++){
		fprintf(ofp_poly,"%lf ",*(posin + j));
		for(i = 0; i < 2*N; i++){
			fprintf(ofp_poly,"%d ",*((*(neutin + i)) + j));
		}
		fprintf(ofp_poly,"\n");
	}
	fclose(ofp_poly);

}	/* End of population printing routine */

/* Printing polymorphism routines */
void polyprint(unsigned int **neutin, double *posin, unsigned int npoly, unsigned int N){
	unsigned int i, j;		/* pop counter, poly counter */

	for(j = 0; j < npoly; j++){
		printf("%lf ",*(posin + j));
		for(i = 0; i < 2*N; i++){
			printf("%d ",*((*(neutin + i)) + j));
		}
		printf("\n");
	}
	Wait();

}	/* End of reassignment routine */

/* Cutting out non-polymorphic sites */
void ptrim(unsigned int size, unsigned int **neutin, unsigned int **neutout, double *posin, double *posout, unsigned int npoly, unsigned int *npolyT, double *avpi){
	unsigned int i, j;
	unsigned int newp = 0;		/* New number of polymorphisms */
	unsigned int count = 0;		/* Polymorphism count */
	double cumpi = 0;			/* Cumulative pi (diversity) */

/*	printf("Trimming routine activated\n");	*/
	for(j = 0; j < npoly; j++){
		count = 0;
		*(posout + newp) = *(posin + j);
		for(i = 0; i < size; i++){
			*((*(neutout + i)) + newp) = *((*(neutin + i)) + j);
			count += *((*(neutin + i)) + j);
		}
/*		printf("For poly %d, count is %d\n",j,count);*/
		if((count > 0) && (count < size)){
/*			printf("Keeping poly %d at location %lf\n",j,*(posin + j));	*/
			newp++;
			cumpi += ((count*(size-count))/(1.0*size*size));
/*			printf("Count is %d, freq is %lf, cumulative value is %lf\n",count,count/(1.0*size),cumpi);	*/
		}

		/*
		if(count==size){
			printf("A fixed neutral mutation here\n");
		}
		*/

	}

	*npolyT = newp;
	*avpi = (cumpi/(1.0*newp));
}

/* Count number of unique haplotypes */
unsigned int uniqueH(unsigned int **neutin, unsigned int npoly, unsigned int N){

	unsigned int i, j, k;
	unsigned int unH = 0;			/* Count of unique haplotypes */
	unsigned int nomatch = 0;		/* Marker to show if sites do not match */

	unsigned int **UH = calloc(2*N,sizeof(unsigned int *));
	for(i = 0; i < 2*N; i++){
		UH[i] = calloc(npoly,sizeof(unsigned int));
	}

	/* Assigning first unique haplotype */
	for(j = 0; j < npoly; j++){
		*((*(UH + 0)) + j) = *((*(neutin + 0)) + j);
	}
	unH++;

	/* Now testing other haplotypes */
	for(i = 0; i < 2*N; i++){
		nomatch = 0;
		for(k = 0; k < unH; k++){
			for(j = 0; j < npoly; j++){
				if(*((*(UH + k)) + j) != *((*(neutin + i)) + j)){
					nomatch++;
					break;
				}
			}
		}

		if(nomatch == unH){		/* If haplotype does not match ANY unique ones, then add as new */
			for(j = 0; j < npoly; j++){
				*((*(UH + unH)) + j) = *((*(neutin + i)) + j);
			}
			unH++;
		}
	}

	for(i = 0; i < 2*N; i++){
		free(UH[i]);
	}
	free(UH);

	return unH;

}

/* Main program */
int main(int argc, char *argv[]){

	/* Declare variables here */
	unsigned int a, i;			/* Counters */
	unsigned int N = 0;			/* Population Size */
	unsigned int npoly = 0;		/* Number of neutral alleles */
	unsigned int npolyT = 0;	/* Number of neutral alleles (after cutting out fixed sites) */
	unsigned int suffix = 0;	/* Number of times to subsample from population */
	unsigned int base = 0;		/* Number of baseline forward-in-time simulations */
/*	unsigned int n = 0;			sprintf counter */
	unsigned int ttot = 0;		/* Total time of simulation */
/*	unsigned int unH = 0;		 Number of unique haplotypes */
	unsigned int tbi = 0;		/* Burn-in time */
/*	double npr = 0;				 Number of times to print out number of stats */
	double self = 0;			/* Selfing rate */
	double Rin = 0;				/* Recombination rate (input) */
	double R = 0;				/* Recombination rate (at a time) */
	double theta = 0;			/* Rate of neutral mutation */
	double avpi = 0;
	char Sout[32];				/* String to hold filename in (Seed) */
	FILE *ofp_sd;				/* Pointer for seed output */

	/* GSL random number definitions */
	const gsl_rng_type * T;
	gsl_rng * r;

	/* Reading in data from command line */
	if(argc != 7){
		fprintf(stderr,"Not enough inputs (need: N self R theta basereps suffix).\n");
		exit(1);
	}

	N = atoi(argv[1]);
	if(N <= 0){
		fprintf(stderr,"Total Population size N is zero or negative, not allowed.\n");
		exit(1);
	}

	self = strtod(argv[2],NULL);
	if(self < 0 || self > 1){
		fprintf(stderr,"Selfing rate must lie between 0 and 1 (inclusive).\n");
		exit(1);
	}

	Rin = strtod(argv[3],NULL);
	if(Rin < 0){
		fprintf(stderr,"Recombination rate must be positive or zero.\n");
		exit(1);
	}
	Rin /= 2.0*N;

	theta = strtod(argv[4],NULL);
	if(theta <= 0){
		fprintf(stderr,"Mutation rate must be a positive value.\n");
		exit(1);
	}

	base = atoi(argv[5]);
	if(base <= 0){
		fprintf(stderr,"Number of baseline simulations must be greater than zero.\n");
		exit(1);
	}

	suffix = atoi(argv[6]);
	if(argv[6] < 0){
		fprintf(stderr,"File index must be greater than or equal to zero.\n");
		exit(1);
	}

	/* create a generator chosen by the
    environment variable GSL_RNG_TYPE */

    mkdir("SeedsPop/", 0777);
	gsl_rng_env_setup();
	if (!getenv("GSL_RNG_SEED")) gsl_rng_default_seed = time(0);
	T = gsl_rng_default;
	r = gsl_rng_alloc(T);
	sprintf(Sout,"SeedsPop/Seed_%d.dat",suffix);
	ofp_sd = fopen(Sout,"w");
	fprintf(ofp_sd,"%lu\n",gsl_rng_default_seed);
	fclose(ofp_sd);

	/* Vector of 0 to (N-1) for sampling random numbers */
	unsigned int *nums = calloc(N,sizeof(unsigned int));
	unsigned int *nums2 = calloc(2*N,sizeof(unsigned int));
	for(a = 0; a < 2*N; a++){
		*(nums2 + a) = a;
		if(a < N){
			*(nums + a) = a;
		}
	}

	/* Executing simulation */
	for(i = 0; i < base; i++){

/*		printf("Starting run %d\n",i);*/

		/* Setting up selection, neutral tables per individual */
		double *polypos = calloc(INITTS,sizeof(double));						/* Position of neutral mutations */
		double *polyposF = calloc(INITTS,sizeof(double));						/* Position of neutral mutations (final for polymorphism sampling) */
		unsigned int **neutindvP = calloc(2*N,sizeof(unsigned int *));			/* Table of neutral markers per individual (parents) */
		unsigned int **neutindvO = calloc(2*N,sizeof(unsigned int *));			/* Table of neutral markers per individual (offspring) */
		unsigned int **neutindvF = calloc(2*N,sizeof(unsigned int *));			/* Table of neutral markers per individual (final for sampling) */
		for(a = 0; a < 2*N; a++){
			neutindvP[a] = calloc(INITTS,sizeof(unsigned int));
			neutindvO[a] = calloc(INITTS,sizeof(unsigned int));
			neutindvF[a] = calloc(INITTS,sizeof(unsigned int));
		}
		npoly = 0;
		ttot = 0;
		R = Rin;
		tbi = 20*N;
/*		npr = 20.0;	*/

		while(ttot < tbi){

			/*
			int tick = (tbi)/(npr);
			if(ttot%tick == 0){
				unH = uniqueH(neutindvP, npoly, N);
				printf("Time is %d; npoly is %d; av pi is %lf, unique haps are %d\n",ttot,npoly,avpi,unH);
			}
			*/

			/* Generating new population */
			generation_BI(N,self,R,nums,neutindvP,neutindvO,npoly,polypos,r);

			/* Neutral Mutation phase */
			addpoly(N, neutindvO, polypos, &npoly, theta, r);

			/* Reassigning matrices */
			reassign2(neutindvO, neutindvP, polyposF, polypos, npoly, N, 0);

			ttot++;
			ptrim(2*N, neutindvP, neutindvF, polypos, polyposF, npoly, &npolyT, &avpi);
			npoly = npolyT;
			reassign2(neutindvF, neutindvP, polyposF, polypos, npoly, N, 1);

			/*
			printf("Number of unique haplotypes are %d\n",uniqueH(neutindvP, npoly, N));
			polyprint(neutindvP, polypos, npoly, N);
			*/
		}
/*		printf("End of burn-in\n");*/

		/* After burn-in, print out neutral mutants  */
		popprint(neutindvP, polypos, npoly, N, i, suffix);

		/*
		reassign2(neutindvP, neutindvA, polypos, polyposA, npoly, N);
		npolyA = npoly;
		*/

		for(a = 0; a < 2*N; a++){
			free(neutindvF[a]);
			free(neutindvO[a]);
			free(neutindvP[a]);
		}
		free(neutindvF);
		free(neutindvO);
		free(neutindvP);
		free(polyposF);
		free(polypos);

	}

	free(nums2);
	free(nums);
	gsl_rng_free(r);

	return 0;

}	/* End of main program */

/* End of File */


#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <mpi.h>
#include <gsl/gsl_math.h>

#ifdef SUBFIND

#include "allvars.h"
#include "proto.h"
#include "subfind.h"

/*! Structure for communication during the density computation. Holds data that is sent to other processors.
 */
static struct linkngbdata_in
{
  MyDouble Pos[3];
  MyFloat DM_Hsml;
  int NodeList[NODELISTLENGTH];
}
 *LinkngbDataIn, *LinkngbDataGet;

static struct linkngbdata_out
{
  int Ngb;
}
 *LinkngbDataResult, *LinkngbDataOut;

void subfind_find_linkngb(void)
{
  long long ntot;
  int i, j, ndone, ndone_flag, npleft, dummy, iter = 0, save_DesNumNgb;
  MyFloat *Left, *Right;
  char *Todo;
  int ngrp, sendTask, recvTask, place, nexport, nimport;
  double dmax1, dmax2, t0, t1;

  if(ThisTask == 0)
    printf("Start find_linkngb (%d particles on task=%d)\n", NumPartGroup, ThisTask);

  save_DesNumNgb = All.DesNumNgb;
  All.DesNumNgb = All.DesLinkNgb;	/* for simplicity, reset this value */

  /* allocate buffers to arrange communication */

  Ngblist = (int *) mymalloc(NumPartGroup * sizeof(int));
  Dist2list = (double *) mymalloc(NumPartGroup * sizeof(double));

  All.BunchSize =
    (int) ((All.BufferSize * 1024 * 1024) / (sizeof(struct data_index) + sizeof(struct data_nodelist) +
					     sizeof(struct linkngbdata_in) + sizeof(struct linkngbdata_out) +
					     sizemax(sizeof(struct linkngbdata_in),
						     sizeof(struct linkngbdata_out))));
  DataIndexTable = (struct data_index *) mymalloc(All.BunchSize * sizeof(struct data_index));
  DataNodeList = (struct data_nodelist *) mymalloc(All.BunchSize * sizeof(struct data_nodelist));

  Left = mymalloc(sizeof(MyFloat) * NumPartGroup);
  Right = mymalloc(sizeof(MyFloat) * NumPartGroup);
  Todo = mymalloc(sizeof(char) * NumPartGroup);

  for(i = 0; i < NumPartGroup; i++)
    {
      Left[i] = Right[i] = 0;
      Todo[i] = 1;
    }

  /* we will repeat the whole thing for those particles where we didn't find enough neighbours */
  do
    {
      t0 = second();

      i = 0;			/* begin with this index */

      do
	{
	  for(j = 0; j < NTask; j++)
	    {
	      Send_count[j] = 0;
	      Exportflag[j] = -1;
	    }

	  /* do local particles and prepare export list */

	  for(nexport = 0; i < NumPartGroup; i++)
	    {
	      if(Todo[i])
		{
		  if(subfind_linkngb_evaluate(i, 0, &nexport, Send_count) < 0)
		    break;
		}
	    }

	  qsort(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);

	  MPI_Allgather(Send_count, NTask, MPI_INT, Sendcount_matrix, NTask, MPI_INT, MPI_COMM_WORLD);

	  for(j = 0, nimport = 0, Recv_offset[0] = 0, Send_offset[0] = 0; j < NTask; j++)
	    {
	      Recv_count[j] = Sendcount_matrix[j * NTask + ThisTask];
	      nimport += Recv_count[j];

	      if(j > 0)
		{
		  Send_offset[j] = Send_offset[j - 1] + Send_count[j - 1];
		  Recv_offset[j] = Recv_offset[j - 1] + Recv_count[j - 1];
		}
	    }

	  LinkngbDataGet = (struct linkngbdata_in *) mymalloc(nimport * sizeof(struct linkngbdata_in));
	  LinkngbDataIn = (struct linkngbdata_in *) mymalloc(nexport * sizeof(struct linkngbdata_in));

	  /* prepare particle data for export */
	  for(j = 0; j < nexport; j++)
	    {
	      place = DataIndexTable[j].Index;

	      LinkngbDataIn[j].Pos[0] = P[place].Pos[0];
	      LinkngbDataIn[j].Pos[1] = P[place].Pos[1];
	      LinkngbDataIn[j].Pos[2] = P[place].Pos[2];
	      LinkngbDataIn[j].DM_Hsml = P[place].DM_Hsml;

	      memcpy(LinkngbDataIn[j].NodeList,
		     DataNodeList[DataIndexTable[j].IndexGet].NodeList, NODELISTLENGTH * sizeof(int));
	    }

	  /* exchange particle data */
	  for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
	    {
	      sendTask = ThisTask;
	      recvTask = ThisTask ^ ngrp;

	      if(recvTask < NTask)
		{
		  if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
		    {
		      /* get the particles */
		      MPI_Sendrecv(&LinkngbDataIn[Send_offset[recvTask]],
				   Send_count[recvTask] * sizeof(struct linkngbdata_in), MPI_BYTE,
				   recvTask, TAG_DENS_A,
				   &LinkngbDataGet[Recv_offset[recvTask]],
				   Recv_count[recvTask] * sizeof(struct linkngbdata_in), MPI_BYTE,
				   recvTask, TAG_DENS_A, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
		    }
		}
	    }

	  myfree(LinkngbDataIn);
	  LinkngbDataResult = (struct linkngbdata_out *) mymalloc(nimport * sizeof(struct linkngbdata_out));
	  LinkngbDataOut = (struct linkngbdata_out *) mymalloc(nexport * sizeof(struct linkngbdata_out));

	  /* now do the particles that were sent to us */
	  for(j = 0; j < nimport; j++)
	    subfind_linkngb_evaluate(j, 1, &dummy, &dummy);

	  if(i >= NumPartGroup)
	    ndone_flag = 1;
	  else
	    ndone_flag = 0;

	  MPI_Allreduce(&ndone_flag, &ndone, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);

	  /* get the result */
	  for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
	    {
	      sendTask = ThisTask;
	      recvTask = ThisTask ^ ngrp;
	      if(recvTask < NTask)
		{
		  if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
		    {
		      /* send the results */
		      MPI_Sendrecv(&LinkngbDataResult[Recv_offset[recvTask]],
				   Recv_count[recvTask] * sizeof(struct linkngbdata_out),
				   MPI_BYTE, recvTask, TAG_DENS_B,
				   &LinkngbDataOut[Send_offset[recvTask]],
				   Send_count[recvTask] * sizeof(struct linkngbdata_out),
				   MPI_BYTE, recvTask, TAG_DENS_B, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
		    }
		}
	    }

	  /* add the result to the local particles */
	  for(j = 0; j < nexport; j++)
	    {
	      place = DataIndexTable[j].Index;

	      P[place].DM_NumNgb += LinkngbDataOut[j].Ngb;
	    }

	  myfree(LinkngbDataOut);
	  myfree(LinkngbDataResult);
	  myfree(LinkngbDataGet);
	}
      while(ndone < NTask);

      /* do final operations on results */
      for(i = 0, npleft = 0; i < NumPartGroup; i++)
	{
	  /* now check whether we had enough neighbours */
	  if(Todo[i])
	    {
	      if(P[i].DM_NumNgb != All.DesLinkNgb &&
		 ((Right[i] - Left[i]) > 1.0e-3 * Left[i] || Left[i] == 0 || Right[i] == 0))
		{
		  /* need to redo this particle */
		  npleft++;

		  if(P[i].DM_NumNgb < All.DesLinkNgb)
		    Left[i] = DMAX(P[i].DM_Hsml, Left[i]);
		  else
		    {
		      if(Right[i] != 0)
			{
			  if(P[i].DM_Hsml < Right[i])
			    Right[i] = P[i].DM_Hsml;
			}
		      else
			Right[i] = P[i].DM_Hsml;
		    }

		  if(iter >= MAXITER - 10)
		    {
		      printf
			("i=%d task=%d ID=%d DM_Hsml=%g Left=%g Right=%g Ngbs=%g Right-Left=%g\n   pos=(%g|%g|%g)\n",
			 i, ThisTask, (int) P[i].ID, P[i].DM_Hsml, Left[i], Right[i],
			 (double) P[i].DM_NumNgb, Right[i] - Left[i], P[i].Pos[0], P[i].Pos[1], P[i].Pos[2]);
		      fflush(stdout);
		    }

		  if(Right[i] > 0 && Left[i] > 0)
		    P[i].DM_Hsml = pow(0.5 * (pow(Left[i], 3) + pow(Right[i], 3)), 1.0 / 3);
		  else
		    {
		      if(Right[i] == 0 && Left[i] == 0)
			endrun(8189);	/* can't occur */

		      if(Right[i] == 0 && Left[i] > 0)
			P[i].DM_Hsml *= 1.26;

		      if(Right[i] > 0 && Left[i] == 0)
			P[i].DM_Hsml /= 1.26;
		    }
		}
	      else
		Todo[i] = 0;
	    }
	}

      sumup_large_ints(1, &npleft, &ntot);

      t1 = second();

      if(ntot > 0)
	{
	  iter++;

	  if(iter > 0 && ThisTask == 0)
	    {
	      printf("find linkngb iteration %d: need to repeat for %d%09d particles. (took %g sec)\n", iter,
		     (int) (ntot / 1000000000), (int) (ntot % 1000000000), timediff(t0, t1));
	      fflush(stdout);
	    }

	  if(iter > MAXITER)
	    {
	      printf("failed to converge in neighbour iteration in density()\n");
	      fflush(stdout);
	      endrun(1155);
	    }
	}
    }
  while(ntot > 0);

  myfree(Todo);
  myfree(Right);
  myfree(Left);

  myfree(DataNodeList);
  myfree(DataIndexTable);

  myfree(Dist2list);
  myfree(Ngblist);

  All.DesNumNgb = save_DesNumNgb;	/* restore it */
}

/*! This function represents the core of the SPH density computation. The
 *  target particle may either be local, or reside in the communication
 *  buffer.
 */
int subfind_linkngb_evaluate(int target, int mode, int *nexport, int *nsend_local)
{
  int startnode, numngb, ngbs, listindex = 0;
  double hmax;
  double h, h2, hinv, hinv3;
  MyDouble *pos;

  numngb = 0;

  if(mode == 0)
    {
      pos = P[target].Pos;
      h = P[target].DM_Hsml;
    }
  else
    {
      pos = LinkngbDataGet[target].Pos;
      h = LinkngbDataGet[target].DM_Hsml;
    }

  h2 = h * h;
  hinv = 1.0 / h;
  hinv3 = hinv * hinv * hinv;

  if(mode == 0)
    {
      startnode = All.MaxPart;	/* root node */
    }
  else
    {
      startnode = LinkngbDataGet[target].NodeList[0];
      startnode = Nodes[startnode].u.d.nextnode;	/* open it */
    }

  numngb = 0;

  while(startnode >= 0)
    {
      while(startnode >= 0)
	{
	  ngbs = subfind_ngb_treefind_linkngb(pos, h, target, &startnode, mode, &hmax, nexport, nsend_local);

	  if(ngbs < 0)
	    return -1;

	  if(mode == 0 && hmax > 0)
	    P[target].DM_Hsml = hmax;

	  numngb += ngbs;
	}

      if(mode == 1)
	{
	  listindex++;
	  if(listindex < NODELISTLENGTH)
	    {
	      startnode = LinkngbDataGet[target].NodeList[listindex];
	      if(startnode >= 0)
		startnode = Nodes[startnode].u.d.nextnode;	/* open it */
	    }
	}
    }

  if(mode == 0)
    {
      P[target].DM_NumNgb = numngb;
    }
  else
    {
      LinkngbDataResult[target].Ngb = numngb;
    }

  return 0;
}

int subfind_ngb_treefind_linkngb(MyDouble searchcenter[3], double hsml, int target, int *startnode, int mode,
				 double *hmax, int *nexport, int *nsend_local)
{
  int numngb, i, no, p, task, nexport_save, exported = 0;
  struct NODE *current;
  double dx, dy, dz, dist, r2;

#ifdef PERIODIC
  MyDouble xtmp;
#endif

  nexport_save = *nexport;

  *hmax = 0;
  numngb = 0;
  no = *startnode;

  while(no >= 0)
    {
      if(no < All.MaxPart)	/* single particle */
	{
	  p = no;
	  no = Nextnode[no];

#ifdef DENSITY_SPLIT_BY_TYPE
	  if(!((1 << P[p].Type) & (DENSITY_SPLIT_BY_TYPE)))
#else
	  if(!((1 << P[p].Type) & (FOF_PRIMARY_LINK_TYPES)))
#endif
	    continue;

	  dist = hsml;
	  dx = NGB_PERIODIC_LONG_X(P[p].Pos[0] - searchcenter[0]);
	  if(dx > dist)
	    continue;
	  dy = NGB_PERIODIC_LONG_Y(P[p].Pos[1] - searchcenter[1]);
	  if(dy > dist)
	    continue;
	  dz = NGB_PERIODIC_LONG_Z(P[p].Pos[2] - searchcenter[2]);
	  if(dz > dist)
	    continue;
	  if((r2 = (dx * dx + dy * dy + dz * dz)) > dist * dist)
	    continue;

	  Dist2list[numngb] = r2;
	  Ngblist[numngb++] = p;
	}
      else
	{
	  if(no >= All.MaxPart + MaxNodes)	/* pseudo particle */
	    {
	      if(mode == 1)
		endrun(12312);

	      if(target >= 0)	/* if no target is given, export will not occur */
		{
		  exported = 1;
		  if(Exportflag[task = DomainTask[no - (All.MaxPart + MaxNodes)]] != target)
		    {
		      Exportflag[task] = target;
		      Exportnodecount[task] = NODELISTLENGTH;
		    }

		  if(Exportnodecount[task] == NODELISTLENGTH)
		    {
		      if(*nexport >= All.BunchSize)
			{
			  *nexport = nexport_save;
			  if(nexport_save == 0)
			    endrun(13004);	/* in this case, the buffer is too small to process even a single particle */
			  for(task = 0; task < NTask; task++)
			    nsend_local[task] = 0;
			  for(no = 0; no < nexport_save; no++)
			    nsend_local[DataIndexTable[no].Task]++;
			  return -1;
			}
		      Exportnodecount[task] = 0;
		      Exportindex[task] = *nexport;
		      DataIndexTable[*nexport].Task = task;
		      DataIndexTable[*nexport].Index = target;
		      DataIndexTable[*nexport].IndexGet = *nexport;
		      *nexport = *nexport + 1;
		      nsend_local[task]++;
		    }

		  DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]++] =
		    DomainNodeIndex[no - (All.MaxPart + MaxNodes)];

		  if(Exportnodecount[task] < NODELISTLENGTH)
		    DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]] = -1;
		}

	      no = Nextnode[no - MaxNodes];
	      continue;
	    }

	  current = &Nodes[no];

	  if(mode == 1)
	    {
	      if(current->u.d.bitflags & (1 << BITFLAG_TOPLEVEL))	/* we reached a top-level node again, which means that we are done with the branch */
		{
		  *startnode = -1;
		  return numngb;
		}
	    }

	  no = current->u.d.sibling;	/* in case the node can be discarded */

	  dist = hsml + 0.5 * current->len;;
	  dx = NGB_PERIODIC_LONG_X(current->center[0] - searchcenter[0]);
	  if(dx > dist)
	    continue;
	  dy = NGB_PERIODIC_LONG_Y(current->center[1] - searchcenter[1]);
	  if(dy > dist)
	    continue;
	  dz = NGB_PERIODIC_LONG_Z(current->center[2] - searchcenter[2]);
	  if(dz > dist)
	    continue;
	  /* now test against the minimal sphere enclosing everything */
	  dist += FACT1 * current->len;
	  if(dx * dx + dy * dy + dz * dz > dist * dist)
	    continue;

	  no = current->u.d.nextnode;	/* ok, we need to open the node */
	}
    }

  if(mode == 0)			/* local particle */
    if(exported == 0)		/* completely local */
      if(numngb >= All.DesNumNgb)
	{
	  R2list = mymalloc(sizeof(struct r2data) * numngb);
	  for(i = 0; i < numngb; i++)
	    {
	      R2list[i].index = Ngblist[i];
	      R2list[i].r2 = Dist2list[i];
	    }

	  qsort(R2list, numngb, sizeof(struct r2data), subfind_ngb_compare_dist);

	  *hmax = sqrt(R2list[All.DesNumNgb - 1].r2);
	  numngb = All.DesNumNgb;

	  for(i = 0; i < numngb; i++)
	    {
	      Ngblist[i] = R2list[i].index;
	      Dist2list[i] = R2list[i].r2;
	    }

	  myfree(R2list);
	}

  *startnode = -1;
  return numngb;
}

#ifdef DENSITY_SPLIT_BY_TYPE
/*! This routine finds all neighbours `j' that can interact with
 *  \f$ r_{ij} < h_i \f$  OR if  \f$ r_{ij} < h_j \f$.
 */
int subfind_ngb_treefind_linkpairs(MyDouble searchcenter[3], double hsml, int target, int *startnode,
				   int mode, double *hmax, int *nexport, int *nsend_local)
{
  int numngb, i, no, p, task, nexport_save, exported = 0;
  struct NODE *current;
  double dx, dy, dz, dist, r2, dmax1, dmax2;

#ifdef PERIODIC
  MyDouble xtmp;
#endif

  nexport_save = *nexport;

  *hmax = 0;
  numngb = 0;
  no = *startnode;

  while(no >= 0)
    {
      if(no < All.MaxPart)	/* single particle */
	{
	  p = no;
	  no = Nextnode[no];

#ifdef DENSITY_SPLIT_BY_TYPE
	  if(!((1 << P[p].Type) & (DENSITY_SPLIT_BY_TYPE)))
#else
	  if(!((1 << P[p].Type) & (FOF_PRIMARY_LINK_TYPES)))
#endif
	    continue;

	  dist = DMAX(P[p].DM_Hsml, hsml);
	  dx = NGB_PERIODIC_LONG_X(P[p].Pos[0] - searchcenter[0]);
	  if(dx > dist)
	    continue;
	  dy = NGB_PERIODIC_LONG_Y(P[p].Pos[1] - searchcenter[1]);
	  if(dy > dist)
	    continue;
	  dz = NGB_PERIODIC_LONG_Z(P[p].Pos[2] - searchcenter[2]);
	  if(dz > dist)
	    continue;
	  if((r2 = (dx * dx + dy * dy + dz * dz)) > dist * dist)
	    continue;

	  Dist2list[numngb] = r2;
	  Ngblist[numngb++] = p;
	}
      else
	{
	  if(no >= All.MaxPart + MaxNodes)	/* pseudo particle */
	    {
	      if(mode == 1)
		endrun(12312);

	      if(target >= 0)	/* if no target is given, export will not occur */
		{
		  exported = 1;
		  if(Exportflag[task = DomainTask[no - (All.MaxPart + MaxNodes)]] != target)
		    {
		      Exportflag[task] = target;
		      Exportnodecount[task] = NODELISTLENGTH;
		    }

		  if(Exportnodecount[task] == NODELISTLENGTH)
		    {
		      if(*nexport >= All.BunchSize)
			{
			  *nexport = nexport_save;
			  if(nexport_save == 0)
			    endrun(13004);	/* in this case, the buffer is too small to process even a single particle */
			  for(task = 0; task < NTask; task++)
			    nsend_local[task] = 0;
			  for(no = 0; no < nexport_save; no++)
			    nsend_local[DataIndexTable[no].Task]++;
			  return -1;
			}
		      Exportnodecount[task] = 0;
		      Exportindex[task] = *nexport;
		      DataIndexTable[*nexport].Task = task;
		      DataIndexTable[*nexport].Index = target;
		      DataIndexTable[*nexport].IndexGet = *nexport;
		      *nexport = *nexport + 1;
		      nsend_local[task]++;
		    }

		  DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]++] =
		    DomainNodeIndex[no - (All.MaxPart + MaxNodes)];

		  if(Exportnodecount[task] < NODELISTLENGTH)
		    DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]] = -1;
		}

	      no = Nextnode[no - MaxNodes];
	      continue;
	    }

	  current = &Nodes[no];

	  if(mode == 1)
	    {
	      if(current->u.d.bitflags & (1 << BITFLAG_TOPLEVEL))	/* we reached a top-level node again, which means that we are done with the branch */
		{
		  *startnode = -1;
		  return numngb;
		}
	    }

	  dist = DMAX(Extnodes[no].hmax, hsml) + 0.5 * current->len;
	  no = current->u.d.sibling;	/* in case the node can be discarded */
	  dx = NGB_PERIODIC_LONG_X(current->center[0] - searchcenter[0]);
	  if(dx > dist)
	    continue;
	  dy = NGB_PERIODIC_LONG_Y(current->center[1] - searchcenter[1]);
	  if(dy > dist)
	    continue;
	  dz = NGB_PERIODIC_LONG_Z(current->center[2] - searchcenter[2]);
	  if(dz > dist)
	    continue;
	  /* now test against the minimal sphere enclosing everything */
	  dist += FACT1 * current->len;
	  if(dx * dx + dy * dy + dz * dz > dist * dist)
	    continue;

	  no = current->u.d.nextnode;	/* ok, we need to open the node */
	}
    }

  if(mode == 0)			/* local particle */
    if(exported == 0)		/* completely local */
      if(numngb >= All.DesNumNgb)
	{
	  R2list = mymalloc(sizeof(struct r2data) * numngb);
	  for(i = 0; i < numngb; i++)
	    {
	      R2list[i].index = Ngblist[i];
	      R2list[i].r2 = Dist2list[i];
	    }

	  qsort(R2list, numngb, sizeof(struct r2data), subfind_ngb_compare_dist);

	  *hmax = sqrt(R2list[All.DesNumNgb - 1].r2);
	  numngb = All.DesNumNgb;

	  for(i = 0; i < numngb; i++)
	    {
	      Ngblist[i] = R2list[i].index;
	      Dist2list[i] = R2list[i].r2;
	    }

	  myfree(R2list);
	}

  *startnode = -1;
  return numngb;
}
#endif

int subfind_ngb_compare_dist(const void *a, const void *b)
{
  if(((struct r2data *) a)->r2 < (((struct r2data *) b)->r2))
    return -1;

  if(((struct r2data *) a)->r2 > (((struct r2data *) b)->r2))
    return +1;

  return 0;
}

#endif


/*
Simulation of a network of FitzHugh-Nagumo neurons, coupled by excitatory
chemical synapses, receiving decorrelated, random input spiketrains with
both excitatory and inhibitory components.

The simulation was written by Ekkehard Ullner in 2013.

This is a modified version of E.U.'s original, stand-alone program,
for use as a library (e.g. via the ctypes ffi in Python).
Changelog:
- Various simulation parameters are exposed (to allow arbitrary network topologies,
input patterns, neuron parameters etc.)
- results are written to a provided buffer instead of text files
- the non-free and problematic[0] "Numerical Recipes" RAN1 random number generator
was replaced with a Mersenne Twister rng from the GNU scientific library.
- cosmetics and a minimum of documentation (i.e. the comments)

C Korndoerfer 2014

[0 "Random Numbers in Scientific Computing: An Introduction", Katzgraber, 2010
http://arxiv.org/pdf/1005.4117.pdf]

The MIT License (MIT)

Copyright (c) 2013,2014 Ekkehard Ullner, Clemens Korndörfer

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICU
LAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*/

#include <stdio.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_rng.h>
#include <time.h>
#include <assert.h>

void sagwas(){
    puts("simulation version Oct 12 2016");
}

/* function simulate
 * ------------------
 * Runs a single network simulation with the given parameters and writes the resulting
 * voltage traces into a given buffer.
 *
 * Parameters:
 *
 * N: Number of rows i in the simulated grid of neurons. (regardless of network topology,
 * the network is a 'grid' where each node is adressed by an (i,j) coordinate.)
 * M: number of columns j in the grid
 *
 * limit: max. simulation time
 * rec_resolution: to store only every ~'th simulation step.
 *
 * KT: maximum number of coupled neighbors of any node (degree of the network)
 * connection: function pointer, where
 *             connection(i,j,l, '0' | '1') must return the first (second) coordinate of the l'th afferent to cell ij
 *             connection(i,j,l, 's') must return the strength of that connection
 *
 * outputbuffer: array of shape (M,N,limit) in which simulation results will be written in row first order
 *
 * inputc: array of shape (M,N) in row-first order. modulates the rate of input pulses fed into
 *         each cell, values within [0,1]. aka "the stimulus".
 * laminex: firing rate "lambda_in,ex", the base rate of excitatory input spikes modulated by inputc
 * lamini: firing rate "lambda_in,in", the base rate of inhibitory input spikes modulated by inputc
 *
 * double fhn_a: parameter a of the FHN neuron
 * double fhn_eps: parameter epsilon of the FHN neuron
 *
 * double con_upstr_exc: synapse conductance "g^{up,ex}" of the excitatory random external inputs.
 * double con_upstr_inh: synapse conductance "g^{up,in}" of the inhibitory random external inputs.
 *
 * seed: a random seed > 0
 *
 * delta_t : integration step width
 *
 * Return: None (simulation results are passed back as a side effect, by filling the provided output buffer)
*/

void simulate(int M,
              int N,
              int limit,
              int rec_resolution,
              int KT,
              double (*connection)(int,int,int,char),
              double* outputbuffer,
              double* debug_outbuf,
              double* inputc_exc,
              double* inputc_inh,
              double laminex,
              double lamini,
              double fhn_a,
              double fhn_eps,
              double con_upstr_exc,
              double con_upstr_inh,
              double taus,
              double alp,
              double bet,
              double tauni,
              double ani,
              double bni,
              double tauna,
              double ana,
              double bna,
              int seed,
              int verbose,
              double delta_t){

    // say hello & show the current input pattern.
    if (verbose){
        printf(" simulation with seed %d\n",seed);
        printf("laminex: %f\nlamini: %f\nfhn_a: %f\nfhn_eps: %f\ncon_upstr_exc: %f\ncon_upstr_inh: %f\ntaus: %f\nalp: %f\
               \nbet: %f\ntauni: %f\nani: %f\nbni: %f\ntauna: %f\nana: %f\nbna: %f\n", laminex, lamini, fhn_a, fhn_eps, con_upstr_exc,
               con_upstr_inh, taus, alp, bet, tauni, ani, bni, tauna, ana, bna);
        int i1,j1;
        int print_exc, print_inh;
        for (j1 = 0; j1<M; j1++ ){
            for (i1 = 0; i1<N; i1++ ){
                print_exc = inputc_exc[i1 + N*j1]  >  0;
                print_inh = inputc_inh[i1 + N*j1]  >  0;
                if (print_exc && print_inh) printf(" ±");
                else if (print_exc) printf(" +");
                else if (print_inh) printf(" -");
                else printf(" .");
            }
            printf("\n");
        }
    }

    assert(seed>0);
    gsl_rng* rng  =  gsl_rng_alloc(gsl_rng_mt19937);
    gsl_rng_set(rng, seed);

    // Initialisations & constant parameters:
    // neuron model:
    double xold[N][M],xh[N][M],xnew[N][M]; // activation variable (previous value, intermediate value, new value)
    double yold[N][M],yh[N][M],ynew[N][M]; // recovery variable (previous value, intermediate value, new value)
    double Isyn[N][M], Ihsyn[N][M]; // lateral input current (Ihsyn: intermediate value)

    // lateral synapses:
    double rold[N][M],rh[N][M],rnew[N][M];  // fraction of open receptors (previous value, intermediate value, new value).

        // more precisely: r[i][j] is the fraction of open receptors at synapses anywhere in the network
        // that are the target of neuron (i,j). Since all synapses have the same rise and decay constants
        // alpha and beta, the effect of a spike at neuron i,j is the same at all of its target synapses.
        // We can therefore write the fractions of open receptors of all these target synapses as a
        // single variable r[i][j], associated with the source neuron i,j.

    double Tl[N][M]; // spike arrival times "T_j" (indexing follows the same logic as r[][])
    double Hs[N][M]; // transmitter concentrations "[T]_j" (...here, too)
    double Vsyn = 0.0; // synaptic reversal potential

    // double taus = 0.01; // duration of transmitter presence after spike
    double Tm = 1.0; // maximum transmitter concentration

    // double alp = 8.0; // rising time constant of fraction of open receptors
    // double bet = 8.0; // decay time constant of fraction of open receptors

    // activatory external input synapses:
    double rnoa[N][M],rnha[N][M],rnna[N][M]; // fraction of open receptors
    double Tnla[N][M],Hna[N][M]; // spike arrival times and transmitter concentrations
    double Vna  =  0.0; // synaptic reversal potential

    // double tauna  =  0.01; // duration of transmitter presence after spike
    double Tna  =  1.0; // maximum transmitter concentration

    // double ana  =  8.0; // rising time constant of fraction of open receptors
    // double bna  =  8.0; // decay time constant of fraction of open receptors

    // inhibitory external input synapses:
    double rnoi[N][M],rnhi[N][M],rnni[N][M]; // fraction of open receptors (previous value, intermediate value, new value)
    double Tnli[N][M],Hni[N][M]; // spike arrival times and transmitter concentrations
    double Vni  =  - 2.1; // synaptic reversal potential

    // double tauni  =  0.01; // duration of transmitter presence after spike
    double Tni = 1.0; // maximum transmitter concentration

    // double ani = 8.0; // rising time constant of fraction of open receptors
    // double bni = 8.0; // decay time constant of fraction of open receptors

    // misc:
    double xth = 1.0; // spike detection threshold
    long step; // simulation step count
    // double delta_t = 0.001; // integration step width
    // double delta_t = 0.01; // integration step width
    double current_time = 0.0; // simulation time, in some irrelevant real - numbered unit

    long i,j,l; // various loop variables over network nodes. don't ask me why those were chosen as long ints.

    int p1[N][M][KT],p2[N][M][KT]; // lookup tables holding the first (p1) and second (p2) coordinate of the KT'th afferent to neuron N,M
    float conductance_net[N][M][KT]; // lookup table: synapse conductance of the KT'th afferent to neuron N,M
    double in_exc[N][M]; // excitatory stimulus strength (input noise rate modulation) for neuron N,M
    double in_inh[N][M]; // inhibitory ...

    // remaining initialisations:
    for (j = 0;j<M;j++ ){
        for (i = 0;i<N;i++ ){
            in_exc[i][j] =  inputc_exc[i + N * j];
            in_inh[i][j] =  inputc_inh[i + N * j];

            xold[i][j] = -1.05 + 0.2 * (gsl_rng_uniform(rng) - 0.5);
            yold[i][j] = -0.66 + 0.2 * (gsl_rng_uniform(rng) - 0.5);
            rold[i][j] = 0.0;
            rnoa[i][j] = 0.0;
            rnoi[i][j] = 0.0;

            Tl[i][j] = -2 * taus;
            Hs[i][j] = 0.0;
            Isyn[i][j] = 0.0;
            Ihsyn[i][j] = 0.0;
            Tnla[i][j] = -2 * tauna;
            Tnli[i][j] = -2 * tauni;
            Hna[i][j] = 0.0;
            Hni[i][j] = 0.0;
            // network connectivity lookup tables:
            for (l = 0;l<KT;l++ ){
                p1[i][j][l]  =  (int)connection(j,i,l,'0');
                p2[i][j][l]  =  (int)connection(j,i,l,'1');
                conductance_net[i][j][l]  =  connection(j,i,l,'s');
    }}}

    // begin stepwise integration.
    for(step = 1;step<= limit;step++ ){
        if (verbose && (step % (limit/100)  ==  0)){
            printf("\r...%d%%",(int)(100 * step/(double)limit));
            fflush(stdout);
        }

        for (j = 0;j<M;j++ ){
            for (i = 0;i<N;i++ ){
                // set transmitter presence if there was a spike recently,
                // ...for synapses within the network..
                if (Tl[i][j] + taus>current_time) Hs[i][j] = 1.0 * Tm;
                else Hs[i][j] = 0.0;

                // ..for activatory external input synapses..
                if (Tnla[i][j] + tauna>current_time) Hna[i][j] = 1.0 * Tna;
                else  Hna[i][j] = 0.0;

                // ..and for inhibitory external input synapses.
                if (Tnli[i][j] + tauni>current_time) Hni[i][j] = 1.0 * Tni;
                else  Hni[i][j] = 0.0;

                // collect lateral synaptic currents (for first integration step)
                Isyn[i][j] = 0.0;
                for (l = 0;l<KT;l++ ){
                    if(p1[i][j][l]<N && p2[i][j][l]<M)
                        Isyn[i][j]  +=   conductance_net[i][j][l]  *  rold[p1[i][j][l]][p2[i][j][l]] * (xold[i][j] - Vsyn);
                        // Here, we add input currents to neuron (i,j) that depend mostly on
                        // r[ p1[i][j][l] ][ p2[i][j][l] ], that is, on the fraction of open
                        // receptors of those synapses targeted by neighbours projecting
                        // to neuron i,j. These synapses have a high fraction of open receptors
                        // if their source neuron recently fired a spike. Thus, input currents
                        // flow to neuron (i,j) if its neighbours have recently fired a spike.
                }

        }}

        // first integration step
        for (j = 0;j<M;j++ ){
            for (i = 0;i<N;i++ ){
                //FHN neuron: eps * (dx/dt)  =  x -  x^3 / 3 -  y
                xh[i][j]  =  xold[i][j]  +  ( (1./fhn_eps) * (xold[i][j] -  xold[i][j] * xold[i][j] * xold[i][j]/3. -  yold[i][j]) )  *  delta_t;
                xh[i][j] +=  - (1./fhn_eps) * Isyn[i][j] * delta_t;
                //FHN neuron: (dy/dt)  =  x + a
                yh[i][j] = yold[i][j] + (xold[i][j] + fhn_a) * delta_t;

                // fraction of open receptors.. dr/dt  =  alpha [T] (1 - r) -  beta r
                // ..of synapses within the network:
                rh[i][j] = rold[i][j] + (alp * Hs[i][j] * (1 - rold[i][j]) - bet * rold[i][j]) * delta_t;

                // ..of synapses receiving external noise, activatory:
                rnha[i][j] = rnoa[i][j] + (ana * Hna[i][j] * (1 - rnoa[i][j]) - bna * rnoa[i][j]) * delta_t;
                // ..of synapses receiving external noise, inhibitory:
                rnhi[i][j] = rnoi[i][j] + (ani * Hni[i][j] * (1 - rnoi[i][j]) - bni * rnoi[i][j]) * delta_t;

                // directly add input currents from the external noise synapses to the neuron's activation variable:
                xh[i][j] -=  (1./fhn_eps) * con_upstr_exc * rnoa[i][j] * (xold[i][j] - Vna) * delta_t;
                xh[i][j] -=  (1./fhn_eps) * con_upstr_inh * rnoi[i][j] * (xold[i][j] - Vni) * delta_t;
        }}

        // collect updated lateral synaptic currents
        for (j = 0;j<M;j++ ){
            for (i = 0;i<N;i++ ){
                Ihsyn[i][j] = 0.0;
                for (l = 0;l<KT;l++ ){
                    if(p1[i][j][l]<N && p2[i][j][l]<M)
                        Ihsyn[i][j] +=  conductance_net[i][j][l] * rh[p1[i][j][l]][p2[i][j][l]] * (xh[i][j] - Vsyn);
                }
        }}

        // second integration step
        for (j = 0;j<M;j++ ){
            for (i = 0;i<N;i++ ){
                //FHN neuron: eps * (dx/dt)  =  x -  x^3 / 3 -  y
                xnew[i][j] = xold[i][j] + 0.5 * ((1./fhn_eps) * (xold[i][j] - xold[i][j] * xold[i][j] * xold[i][j]/3. - yold[i][j]  +  xh[i][j] - xh[i][j] * xh[i][j] * xh[i][j]/3. - yh[i][j])) * delta_t;
                xnew[i][j] +=  - (1./fhn_eps) * 0.5 * (Isyn[i][j]  +  Ihsyn[i][j]) * delta_t;
                //FHN neuron: (dy/dt)  =  x + a
                ynew[i][j] = yold[i][j] + 0.5 * (xold[i][j] + fhn_a  +  xh[i][j] + fhn_a) * delta_t;

                // fraction of open receptors.. dr/dt  =  alpha [T] (1 - r) -  beta r
                // ..of synapses within the network:
                rnew[i][j] = rold[i][j] + 0.5 * (alp * Hs[i][j] * (1 - rold[i][j]) - bet * rold[i][j]  +  alp * Hs[i][j] * (1 - rh[i][j]) - bet * rh[i][j]) * delta_t;
                // ..of synapses receiving external noise, activatory:
                rnna[i][j] = rnoa[i][j] + 0.5 * (ana * Hna[i][j] * (1 - rnoa[i][j]) - bna * rnoa[i][j]  +  ana * Hna[i][j] * (1 - rnha[i][j]) - bna * rnha[i][j]) * delta_t;
                // ..of synapses receiving external noise, inhibitory:
                rnni[i][j] = rnoi[i][j] + 0.5 * (ani * Hni[i][j] * (1 - rnoi[i][j]) - bni * rnoi[i][j]  +  ani * Hni[i][j] * (1 - rnhi[i][j]) - bni * rnhi[i][j]) * delta_t;

                // directly add input currents from the external noise synapses to the neuron's activation variable:
                xnew[i][j] -=  0.5 * (1./fhn_eps) * con_upstr_exc * (rnoa[i][j] * (xold[i][j] - Vna)  +  rnha[i][j] * (xh[i][j] - Vna)) * delta_t;
                xnew[i][j] -=  0.5 * (1./fhn_eps) * con_upstr_inh * (rnoi[i][j] * (xold[i][j] - Vni)  +  rnhi[i][j] * (xh[i][j] - Vni)) * delta_t;
        }}

        // identify spike times & prepare next step
        current_time = delta_t * step;
        for (j = 0;j<M;j++ ){
            for (i = 0;i<N;i++ ){
                // note spike times within the network
                if(xold[i][j]<xth && xnew[i][j] >= xth){
                    Tl[i][j] = current_time;
                }

                // sample random spike times for activatory external input
                if(gsl_rng_uniform(rng) <=  (laminex * (double)in_exc[i][j]) * delta_t){
                    Tnla[i][j] = current_time;
                }
                // sample random spike times for inhibitory external input
                if(gsl_rng_uniform(rng)<= (lamini * (double)in_inh[i][j]) * delta_t){
                   Tnli[i][j] = current_time;
                }

                // swap
                xold[i][j] = xnew[i][j];
                yold[i][j] = ynew[i][j];
                rold[i][j] = rnew[i][j];
                rnoa[i][j] = rnna[i][j];
                rnoi[i][j] = rnni[i][j];
        }}

        // write the current network state into the provided output buffer.
        // This is a 3D array of shape (M,N,limit) in row first order,
        // so it has strides proportional to (N * limit, limit, 1).
        // ..and we write only every rec_resolution'th step.
        int limit_rec  =  limit/rec_resolution;
        if (step % rec_resolution  ==  0) {
            int linearind  =  0;
            for(int oi  =  0; oi < M; oi++ ) {
                for(int oj  =  0; oj < N; oj++ ) {
                        linearind  =  oi * limit_rec * N  +  oj * limit_rec  +  (step/rec_resolution) - 1;
                        outputbuffer[linearind]  =  xnew[oj][oi];
                        debug_outbuf[linearind]  =  ynew[oj][oi];
                }
            }
        }
    } // end of integration loop
    if (verbose){
        printf("\033[2K");
        fflush(stdout);
    }

    gsl_rng_free(rng);
}

// helper function to play with the random number generator.
void rantest(long seed,int N,double *  out){
    gsl_rng *  rng  =  gsl_rng_alloc(gsl_rng_mt19937); // initialize a mersenne twister rng
    gsl_rng_set(rng, seed); // seed it
    double number  =  - 1;

    for(int i = 0; i<N; i++ ){
        number  =  gsl_rng_uniform(rng); // sample a number
        printf("%ld  %f\n",seed,number);
        out[i]  =  number;
    }
    puts(" - - - ");

    gsl_rng_free(rng);
}


/*
 * Copyright 2020 Makani Technologies LLC
 *
 * Licensed under the Apache License, Version 2.0 (the "License");
 * you may not use this file except in compliance with the License.
 * You may obtain a copy of the License at
 *
 *      http://www.apache.org/licenses/LICENSE-2.0
 *
 * Unless required by applicable law or agreed to in writing, software
 * distributed under the License is distributed on an "AS IS" BASIS,
 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 * See the License for the specific language governing permissions and
 * limitations under the License.
 */

#ifndef SIM_PHYSICS_DVL_AERO_DATABASE_H_
#define SIM_PHYSICS_DVL_AERO_DATABASE_H_

#include <gsl/gsl_vector.h>
#include <stddef.h>
#include <stdint.h>

#include <string>
#include <vector>

#include "common/c_math/force_moment.h"
#include "common/c_math/linalg.h"
#include "common/c_math/vec3.h"
#include "common/macros.h"
#include "sim/physics/aero_types.h"
#include "system/labels.h"

class DvlAeroDatabase {
 public:
  explicit DvlAeroDatabase(const std::string &filename);
  ~DvlAeroDatabase();

  // Returns the total force-moment coefficient at a specific (alpha,
  // beta, omega_hat, flap deflection) operating point.
  void CalcForceMomentCoeff(double alpha, double beta, const Vec3 &omega_hat,
                            const Vec &flaps, ForceMoment *cfm,
                            double thrust_coeff) const {
    CalcForceMomentCoeff(alpha, beta, omega_hat, flaps, cfm, thrust_coeff,
                         nullptr);
  }

  // See function above.  Optionally returns the breakdown of the
  // force-moment coefficient into control and stability derivatives
  // if aero_coeffs is not null.
  void CalcForceMomentCoeff(double alpha, double beta, const Vec3 &omega_hat,
                            const Vec &flaps, ForceMoment *cfm,
                            double thrust_coeff,
                            DvlAeroCoeffs *aero_coeffs) const;

  int32_t num_flaps() const { return num_flaps_; }
  double reynolds_number() const { return reynolds_number_; }

 private:
  // Returns true if the database passes basic sign checks.
  bool IsValid() const;

  // Returns the total force-moment coefficient at a specific (alpha,
  // beta, omega_hat, flap deflection) operating point and the
  // breakdown of this value into control and stability derivatives.
  void CalcDvlAeroCoeffs(double alpha, double beta, const Vec &flaps,
                         DvlAeroCoeffs *coeffs) const;

  void LookupForceMomentCoeff2D(const gsl_vector &cfm_data, size_t size1,
                                size_t size2, int32_t s0, int32_t t0, double ds,
                                double dt, ForceMoment *cfm) const;
  void LookupForceMomentCoeff3D(const gsl_vector &cfm_data, int32_t indices[],
                                double du, double dv, double dw,
                                ForceMoment *cfm) const;

  // Number of flaps used in database.
  int32_t num_flaps_;

  // Reynolds number [#] at which the database was calculated.
  double reynolds_number_;

  // List of angles-of-attack [rad] used in database look-up table.
  gsl_vector *alphas_;

  // List of sideslip angles [rad] used in database look-up table.
  gsl_vector *betas_;

  // Vector of lists of flap deflections [rad], one list for each
  // flap, used in database look-up table.
  std::vector<gsl_vector *> deltas_;

  // Tensor grid of force-moment coefficients at zero flap deflections
  // over angle-of-attack and sideslip, stored as a vector.
  gsl_vector *cfm_;

  // Tensor grid of force-moment stability derivatives at zero flap
  // deflections over angle-of-attack and sideslip, stored as a
  // vector.
  gsl_vector *dcfm_dp_;
  gsl_vector *dcfm_dq_;
  gsl_vector *dcfm_dr_;

  // Vector of tensor grids of increments to the force-moment
  // coefficients, due to flap deflections, for each flap.  The tensor
  // grid is over angle-of-attack, sideslip, and flap deflection, and
  // is stored as a vector.
  std::vector<gsl_vector *> flap_cfms_;

  // Vector of tensor grids of increments to the force-moment
  // stability derivatives, due to flap deflections, for each flap.
  // The tensor grid is over angle-of-attack, sideslip, and flap
  // deflection, and is stored as a vector.
  std::vector<gsl_vector *> flap_dcfm_dps_;
  std::vector<gsl_vector *> flap_dcfm_dqs_;
  std::vector<gsl_vector *> flap_dcfm_drs_;

  DISALLOW_COPY_AND_ASSIGN(DvlAeroDatabase);
};

#endif  // SIM_PHYSICS_DVL_AERO_DATABASE_H_


/**
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include "aXe_grism.h"
#include "aXe_utils.h"
#include "spce_PET.h"
#include "inout_aper.h"
#include "trace_conf.h"
#include "aper_conf.h"
#include "spc_sex.h"
#include "disp_conf.h"
#include "spc_wl_calib.h"
#include "drz2pet_utils.h"

#include "fitsio.h"

#define AXE_IMAGE_PATH   "AXE_IMAGE_PATH"
#define AXE_OUTPUT_PATH  "AXE_OUTPUT_PATH"
#define AXE_DRIZZLE_PATH "AXE_DRIZZLE_PATH"
#define AXE_CONFIG_PATH  "AXE_CONFIG_PATH"

int
main(int argc, char *argv[])
{

  //char           *opt;
  char            option_value[MAXCHAR];
  char            grism_image[MAXCHAR];
  char            grism_image_path[MAXCHAR];

  char            conf_file[MAXCHAR];
  char            conf_file_path[MAXCHAR];

  char            aper_file[MAXCHAR];
  char            aper_file_path[MAXCHAR];

  char            PET_file[MAXCHAR];
  char            PET_file_path[MAXCHAR];
  //char            label[MAXCHAR];
  char            hdu_name[MAXCHAR];
  char            keyword[FLEN_COMMENT];

  int             i;
  //int j, flags;

  object        **oblist;
  observation    *obs=NULL,*wobs=NULL;

  ap_pixel       *result = NULL;
  //d_point         pixel;
  aperture_conf  *conf;

  //dispstruct     *disp;
  //calib_function *wl_calibration;

  //FITScards      *cards;

  int             f_status = 0;

  int             bckmode = 0;
  int             opt_extr=0;
  fitsfile       *PET_fitsptr;
  //fitsfile     ME_fitsptr;

  int             index=0;
  int             extver=0;
  int             exp_ext=0;
  int             con_ext=0;
  int             wht_ext=0;
  int             mod_ext=0;
  int             var_ext=0;

  char list_file[MAXCHAR];
  char list_file_path[MAXCHAR];
  FILE *Filelist;
  static char Buffer[LINE_LEN_MAX];
  char *WorkPtr;
  char *WorkPtr2;
  //double refpntx, refpnty, xoffs;
  double lambda0, dlambda;
  char extname[FLEN_COMMENT];

  if ((argc < 3) || (get_online_option2("help", option_value, argc, argv))) {
    fprintf(stdout,
	    "aXe_DRZ2PET Version %s:\n"
	    "           aXe task that produces one Object or Background  Pixel Extraction\n"
	    "           Table (-bck option) from a set of images created with aXe_DRIZZLE.\n"
	    "           The image list as well as input aperture file (AF) and the aXe\n"
	    "           config are all automatically created by the aXe_DRIZZLE task.\n"
	    "           The format and the usage of the PET's created with aXe_DRZ2PET\n"
	    "           is identical to the PET's created by aXe_AF2PET.\n"
	    "\n"
	    "           The image list is looked for in the current directory.\n"
	    "           The images listed in the image list, the aXe config file and the\n"
	    "           aperture file are looked for in$AXE_DRIZZLE_PATH.\n"
	    "           All outputs are writen to $AXE_DRIZZLE_PATH\n"
	    "\n"
	    "Example:\n"
	    "        aXe_DRZ2PET [image list filename] [aXe config filename] [options]\n"
	    "\n"
	    "Options:\n"
	    "           -bck          - generating a PET for the drizzled background images\n"
	    "                           created by aXE_DRIZZLE using a BAF file instead\n"
	    "                           of a OAF file.\n"
	    "       -in_AF=[string]   - overwrite the automatically generated name\n"
	    "                           of the input aperture file\n"
	    "       -out_PET=[string] - overwrite the automatically generated name\n"
	    "                           of the output PET\n"
	    "\n", RELEASE);
    exit(1);
  }
  fprintf(stdout, "aXe_DRZ2PET: Starting...\n");

  index = 0;

  strcpy (list_file_path, argv[++index]);
  strcpy (list_file, list_file_path);

  /* Get the configuration file name */
  strcpy(conf_file, argv[++index]);
  build_path(AXE_CONFIG_PATH, conf_file, conf_file_path);
  conf = get_aperture_descriptor(conf_file_path);

  // check the background flagg
  if (get_online_option2("bck", option_value, argc, argv))
    bckmode = 1;

  // check the background flagg
  if (get_online_option2("opt_extr", option_value, argc, argv))
    opt_extr = 1;

  /* Fix the PET file name */
  if ((get_online_option2("out_PET", option_value, argc, argv)))
    {
      strcpy (PET_file, option_value);
      strcpy (PET_file_path, option_value);
    }
  else
    {
      strcpy(PET_file, list_file);
      if (bckmode) {
	replace_file_extension(list_file, PET_file, ".fits",
			       ".BCK.PET.fits", -1);
      } else {
	replace_file_extension(list_file, PET_file, ".fits",
			       ".PET.fits", -1);
      }
      build_path(AXE_DRIZZLE_PATH, PET_file, PET_file_path);
    }

  /* Fix the aperture file name */
  if ((get_online_option2("in_AF", option_value, argc, argv))){
    strcpy (aper_file, option_value);
    strcpy (aper_file_path, option_value);
  }
  else {
    if (bckmode){
      replace_file_extension(list_file, aper_file, ".list",
			     ".BAF", -1);}
    else{
      replace_file_extension(list_file, aper_file, ".list",
			     ".OAF", -1);}
    build_path(AXE_DRIZZLE_PATH, aper_file, aper_file_path);
  }

  // give feedback onto the screen:
  // report on input and output
  // and also on specific parameter
  fprintf(stdout,
	  "aXe_DRZ2PET: Input Image List:          %s\n",
	  list_file_path);
  fprintf(stdout,
	  "aXe_DRZ2PET: Input configuration file name: %s\n",
	  conf_file_path);
  fprintf(stdout,
	  "aXe_DRZ2PET: Input aperture file name:      %s\n",
	  aper_file_path);
  fprintf(stdout,
	  "aXe_DRZ2PET: Output Pixel Extraction Table \n"
	  "            (PET) file name:                %s\n",
	  PET_file_path);
  if (opt_extr)
    fprintf(stdout,"aXe_DRZ2PET: Computing optimal weights.\n\n");

  /* Loading the object list */
  fprintf(stdout, "aXe_DRZ2PET: Loading object list...");
  oblist = file_to_object_list_seq(aper_file_path, obs);
  fprintf(stdout, "%d objects loaded.\n\n", object_list_size(oblist));

  /* Create a new empty PET file */
  create_PET(PET_file_path, 1);
  PET_fitsptr = create_PET_opened(PET_file_path, 1);

  fprintf(stdout, "aXe_DRZ2PET: Checking files ... ");
  // check whether all necessary extensions do exist
  i = 0;
  Filelist = fopen (list_file_path, "r");
  if (NULL == Filelist){
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__, "Could not open %s\n",
		 list_file_path);
  }
  while (NULL != fgets (Buffer, LINE_LEN_MAX, Filelist)){

    // cut leading white spaces:
    WorkPtr = Buffer;
    while (isspace ((int) *WorkPtr))
      WorkPtr++;
    //    if (0 == strlen (WorkPtr))
    if (0 == strlen (WorkPtr) || Buffer[0] == '#')
      continue;

    // cut after first item:
    WorkPtr2 = WorkPtr;
    while (!isspace ((int) *WorkPtr2))
      WorkPtr2++;
    *WorkPtr2 = '\0';
    WorkPtr2 = NULL;

    // detemrine the full name of the drizzled grism image
    strcpy (grism_image,WorkPtr);
    build_path (AXE_DRIZZLE_PATH, grism_image, grism_image_path);

    // find the extension numbers for SCI, ERR, CON and load them
    // into the structure 'obs'
    get_extension_numbers(grism_image_path, conf,conf->optkey1,conf->optval1);
    sprintf (hdu_name, "CON");
    con_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
				      conf->optkey1,conf->optval1,extver);
    sprintf (hdu_name, "EXPT");
    exp_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
    				     conf->optkey1,conf->optval1,extver);

  if (conf->science_numext < 0 || conf->errors_numext < 0
      ||  con_ext < 0 || exp_ext < 0)
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		 "aXe_DRZ2PET: Grism file: %s does not have all necessary extensions!\n",
		 grism_image_path);

  if (opt_extr)
    {
      sprintf (hdu_name, "MOD");
      mod_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
					conf->optkey1,conf->optval1,extver);
      //      sprintf (hdu_name, "VAR");
      //     var_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
      //conf->optkey1,conf->optval1,extver);
      var_ext=-1;

      //      if (mod_ext < 0 || var_ext < 0)
      //	aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
      //		     "aXe_DRZ2PET: Grism file: %s does not have necessary extensions for optimale extraction!\n",
      //		     grism_image_path);

    }
  }

  fclose(Filelist);
  fprintf(stdout, "Done\n\n");

  i = 0;
  Filelist = fopen (list_file_path, "r");
  if (NULL == Filelist){
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__, "Could not open %s\n",
		 list_file_path);
  }
  while (NULL != fgets (Buffer, LINE_LEN_MAX, Filelist)){

    // cut leading white spaces:
    WorkPtr = Buffer;
    while (isspace ((int) *WorkPtr))
      WorkPtr++;
    //    if (0 == strlen (WorkPtr))
    if (0 == strlen (WorkPtr) || Buffer[0] == '#')
      continue;

    // cut after first item:
    WorkPtr2 = WorkPtr;
    while (!isspace ((int) *WorkPtr2))
      WorkPtr2++;
    *WorkPtr2 = '\0';
    WorkPtr2 = NULL;

    // detemrine the full name of the drizzled grism image
    strcpy (grism_image,WorkPtr);
    build_path (AXE_DRIZZLE_PATH, grism_image, grism_image_path);
    fprintf(stdout,
	    "aXe_DRZ2PET: Input data file name:      %s\n", grism_image_path);

    // find the extension numbers for SCI, ERR, CON and load them
    // into the structure 'obs'
    get_extension_numbers(grism_image_path, conf,conf->optkey1,conf->optval1);
    sprintf (hdu_name, "CON");
    con_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
    conf->optkey1,conf->optval1,extver);
    obs = load_image_t(grism_image_path, conf->science_numext,
		     conf->errors_numext, con_ext, conf->dqmask, 1.0, 0.0);

    // find the extension numbers for EXPT and load it
    // into the structure 'wobs'
    sprintf (hdu_name, "EXPT");
    exp_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
    				     conf->optkey1,conf->optval1,extver);
    sprintf (hdu_name, "MOD");
    mod_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
    				     conf->optkey1,conf->optval1,extver);
    sprintf (hdu_name, "VAR");
    var_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
				      conf->optkey1,conf->optval1,extver);

    // preliminar for inverse variance weighting!!
    //    var_ext=conf->errors_numext;

    fprintf(stdout, "aXe_DRZ2PET: Using exts %i,%i,%i as SCI,ERR,DQ\n", exp_ext,mod_ext,var_ext);
    wobs = load_image_t(grism_image_path,exp_ext,mod_ext,
			var_ext , -1, 1.0, 0.0);

    // normalize the exposure times to
    // generate  the weights
    normalize_weight(wobs, oblist[i], opt_extr);

    // get initial wavelength and dispersion
    // either from the configuration file an
    // according descriptor
    if (conf->drz_resol > 0.0){
      dlambda = conf->drz_resol;
    }
    else{
      sprintf (keyword, "DLAMBDA");
      dlambda = (double)get_float_from_keyword(grism_image_path, 2, keyword);
    }
    if (conf->drz_lamb0 > 0.0){
      lambda0 = conf->drz_lamb0;
    }
    else{
      sprintf (keyword, "LAMBDA0");
      lambda0 = (double)get_float_from_keyword(grism_image_path, 2, keyword);
    }

    // built the new vector with PET pixels
    result = (ap_pixel*) make_spc_drztable(obs, wobs, oblist[i], lambda0, dlambda);

    // compose the name of the new extension and generate this extension
    get_ID_num(grism_image,extname);
    strcat(extname,"A");
    add_ALL_to_PET(result, extname, PET_fitsptr, 0);

    // copy the keywords OBJECTID and BEAMID to the PET extension
    drzprep_fitstrans(grism_image_path, conf->science_numext, PET_fitsptr);
    //    cards = get_FITS_cards(grism_image_path, conf->science_numext);
    //    put_FITS_cards_opened(PET_fitsptr, cards);
    //    free_FITScards(cards);

    // determine he extension number of the weight
    // image and store the new weights there
    sprintf (hdu_name, "WHT");
    wht_ext = get_hdunum_from_hduname(grism_image_path, hdu_name,
				     conf->optkey1,conf->optval1,extver);
    if (wht_ext < 0){
      wht_ext = gsl_to_FITSimage (wobs->grism, grism_image_path, 0, hdu_name);
      fprintf(stdout, "aXe_DRZ2PET: Weights written to %s %i\n", grism_image_path, wht_ext);
    }
    else{
      wht_ext = gsl_to_FITSimageHDU (wobs->grism, grism_image_path, 0, hdu_name, wht_ext);
      fprintf(stdout, "aXe_DRZ2PET: Weights replaced in %s %i\n", grism_image_path, wht_ext);
    }

    // free the memory
    if (result!=NULL)
      {
	free(result);
	result = NULL;
      }
    free_observation(obs);
    free_observation(wobs);
    i++;
  }

  if (oblist != NULL)
    free_oblist(oblist);

  fclose(Filelist);
  fits_close_file(PET_fitsptr, &f_status);
  if (f_status) {
    aXe_message(aXe_M_FATAL, __FILE__, __LINE__,
		"aXe_DRZ2PET: " "Error closing PET: %s ",
		PET_file_path);
  } else {
    transport_cont_modname(grism_image_path, PET_file_path);
    fprintf(stdout, "aXe_DRZ2PET: PET file %s closed.\n", PET_file_path);
  }

  fprintf(stdout, "aXe_DRZ2PET: Done...\n");
  exit(0);
}