# HG changeset patch
# User jpicarbajal
# Date 1332941557 0
# Node ID 82ff20b4d84945e147784c2a3e98bed39544fc36
# Parent  0ed233a0d08c88c62859ac44b6cb45b242bdf074
system-identitifaction: Adding devel TISEAN files

diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/Makefile.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/Makefile.in	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,47 @@
+SHELL = /bin/sh
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+BINDIR = ${exec_prefix}/@bindir@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+AR = @AR@
+ARFLAGS = @ARFLAGS@
+INSTALL = @INSTALL@
+
+LOADLIBS = routines/libddtsa.a -lm
+
+# list of executables we want to produce
+   ALL =   poincare extrema rescale recurr corr mutual false_nearest \
+	   lyap_r lyap_k lyap_spec d2 av-d2 makenoise  nrlazy low121  \
+	   lzo-test lfo-run lfo-test rbf polynom polyback polynomp polypar \
+           ar-model mem_spec pca ghkss lfo-ar xzero xcor boxcount fsle \
+	   resample histogram nstat_z sav_gol delay lzo-gm arima-model \
+           lzo-run
+
+all: $(ALL) 
+
+routines/libddtsa.a:
+	(cd routines && $(MAKE))
+
+$(ALL): routines/libddtsa.a *.c
+	-$(CC) $(CFLAGS) $(COPTS) -o $@ $@.c $(LOADLIBS)
+
+install: all
+	-for bin in $(ALL); do $(INSTALL) $$bin $(BINDIR); done
+
+clean:
+	@rm -f *.o *~ #*#
+	@rm -f $(ALL)
+	-(cd routines && $(MAKE) clean)
+
+missing:
+	-@for bin in $(ALL); do \
+	   test -z "`$$bin -h 2>&1 | grep Usage`" \
+	      && echo   $$bin "(Dresden C)" >> ../missing.log; \
+	   $$bin -h 2>&1 | cat >>  ../install.log; \
+	  done; :
+
+uninstall:
+	-@for bin in $(ALL); do rm -f $(BINDIR)/$$bin; done
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/ar-model.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/ar-model.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,395 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger*/
+/*Changes:
+  Jun 24, 2005: Output average error for multivariate data
+  Nov 25, 2005: Handle model order = 0
+  Jan 31, 2006: Add verbosity 4 to print data+residuals
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Fits an multivariate AR model to the data and gives\
+ the coefficients\n\tand the residues (or an iterated model)"
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int dim=1,poles=1,ilength;
+unsigned int verbosity=1;
+char *outfile=NULL,*column=NULL,stdo=1,dimset=0,run_model=0;
+char *infile=NULL;
+double **series,*my_average;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+	  " as a possible"
+	  " datafile.\nIf no datafile is given stdin is read. Just - also"
+	  " means stdin\n");
+  fprintf(stderr,"\t-l length of file [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-m dimension [default is 1]\n");
+  fprintf(stderr,"\t-c columns to read [default is 1,...,dimension]\n");
+  fprintf(stderr,"\t-p #order of AR-Fit [default is 1]\n");
+  fprintf(stderr,"\t-s length of iterated model [default no iteration]\n");
+  fprintf(stderr,"\t-o output file name [default is 'datafile'.ar]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+	  "0='only panic messages'\n\t\t"
+	  "1='+ input/output messages'\n\t\t"
+	  "2='+ print residuals though iterating a model'\n\t\t"
+	  "4='+ print original data plus residuals'\n");
+  fprintf(stderr,"\t-h show these options\n\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,argc,'p','u')) != NULL) {
+    sscanf(out,"%u",&poles);
+    if (poles < 1) {
+      fprintf(stderr,"The order should at least be one!\n");
+      exit(127);
+    }
+  }
+  if ((out=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,argc,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(argv,argc,'c','u')) != NULL)
+    column=out;
+  if ((out=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,argc,'s','u')) != NULL) {
+    sscanf(out,"%u",&ilength);
+    run_model=1;
+  }
+  if ((out=check_option(argv,argc,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void set_averages_to_zero(void)
+{
+  double var;
+  long i,j;
+  
+  for (i=0;i<dim;i++) {
+    variance(series[i],length,&my_average[i],&var);
+    for (j=0;j<length;j++)
+      series[i][j] -= my_average[i];
+  }
+}
+
+double** build_matrix(double **mat)
+{
+  long n,i1,j1,i2,j2,hi,hj;
+  double norm;
+  
+  norm=1./((double)length-(double)poles);
+
+  for (i1=0;i1<dim;i1++)
+    for (i2=0;i2<poles;i2++) {
+      hi=i1*poles+i2;
+      for (j1=0;j1<dim;j1++)
+	for (j2=0;j2<poles;j2++) {
+	  hj=j1*poles+j2;
+	  mat[hi][hj]=0.0;
+	  for (n=poles-1;n<length-1;n++)
+	    mat[hi][hj] += series[i1][n-i2]*series[j1][n-j2];
+	  mat[hi][hj] *= norm;
+	}
+    }
+
+  return invert_matrix(mat,(unsigned int)(dim*poles));
+}
+
+void build_vector(double *vec,long comp)
+{
+  long i1,i2,hi,n;
+  double norm;
+
+  norm=1./((double)length-(double)poles);
+
+  for (i1=0;i1<poles*dim;i1++)
+    vec[i1]=0.0;
+  
+  for (i1=0;i1<dim;i1++)
+    for (i2=0;i2<poles;i2++) {
+      hi=i1*poles+i2;
+      for (n=poles-1;n<length-1;n++)
+	vec[hi] += series[comp][n+1]*series[i1][n-i2];
+      vec[hi] *= norm;
+    }
+}
+
+double* multiply_matrix_vector(double **mat,double *vec)
+{
+  long i,j;
+  double *new_vec;
+
+  check_alloc(new_vec=(double*)malloc(sizeof(double)*poles*dim));
+
+  for (i=0;i<poles*dim;i++) {
+    new_vec[i]=0.0;
+    for (j=0;j<poles*dim;j++)
+      new_vec[i] += mat[i][j]*vec[j];
+  }
+  return new_vec;
+}
+
+double* make_residuals(double **diff,double **coeff)
+{
+  long n,d,i,j;
+  double *resi;
+  
+  check_alloc(resi=(double*)malloc(sizeof(double)*dim));
+  for (i=0;i<dim;i++)
+    resi[i]=0.0;
+
+  for (n=poles-1;n<length-1;n++) {
+    for (d=0;d<dim;d++) {
+      diff[d][n+1]=series[d][n+1];
+      for (i=0;i<dim;i++)
+	for (j=0;j<poles;j++)
+	  diff[d][n+1] -= coeff[d][i*poles+j]*series[i][n-j];
+      resi[d] += sqr(diff[d][n+1]);
+    }
+  }
+  for (i=0;i<dim;i++)
+    resi[i]=sqrt(resi[i]/((double)length-(double)poles));
+
+  return resi;
+}
+
+void iterate_model(double **coeff,double *sigma,FILE *file)
+{
+  long i,j,i1,i2,n,d;
+  double **iterate,*swap;
+  
+  check_alloc(iterate=(double**)malloc(sizeof(double*)*(poles+1)));
+  for (i=0;i<=poles;i++)
+    check_alloc(iterate[i]=(double*)malloc(sizeof(double)*dim));
+  rnd_init(0x44325);
+  for (i=0;i<1000;i++)
+    gaussian(1.0);
+  for (i=0;i<dim;i++)
+    for (j=0;j<poles;j++)
+      iterate[j][i]=gaussian(sigma[i]);
+  
+  for (n=0;n<ilength;n++) {
+    for (d=0;d<dim;d++) {
+      iterate[poles][d]=gaussian(sigma[d]);
+      for (i1=0;i1<dim;i1++)
+	for (i2=0;i2<poles;i2++)
+	  iterate[poles][d] += coeff[d][i1*poles+i2]*iterate[poles-1-i2][i1];
+    }
+    if (file != NULL) {
+      for (d=0;d<dim;d++)
+	fprintf(file,"%e ",iterate[poles][d]);
+      fprintf(file,"\n");
+    }
+    else {
+      for (d=0;d<dim;d++)
+	printf("%e ",iterate[poles][d]);
+      printf("\n");
+    }
+
+    swap=iterate[0];
+    for (i=0;i<poles;i++)
+      iterate[i]=iterate[i+1];
+    iterate[poles]=swap;
+  }
+
+  for (i=0;i<=poles;i++)
+    free(iterate[i]);
+  free(iterate);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  double *pm;
+  long i,j;
+  FILE *file;
+  double **mat,**inverse,*vec,**coeff,**diff,avpm;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".ar");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)9,(size_t)1));
+      strcpy(outfile,"stdin.ar");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,column,
+				      dimset,verbosity);
+
+  check_alloc(my_average=(double*)malloc(sizeof(double)*dim));
+  set_averages_to_zero();
+
+  if (poles >= length) {
+    fprintf(stderr,"It makes no sense to have more poles than data! Exiting\n");
+    exit(AR_MODEL_TOO_MANY_POLES);
+  }
+  
+  
+  check_alloc(vec=(double*)malloc(sizeof(double)*poles*dim));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*poles*dim));
+  for (i=0;i<poles*dim;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*poles*dim));
+
+  check_alloc(coeff=(double**)malloc(sizeof(double*)*dim));
+  inverse=build_matrix(mat);
+  for (i=0;i<dim;i++) {
+    build_vector(vec,i);
+    coeff[i]=multiply_matrix_vector(inverse,vec);
+  }
+
+  check_alloc(diff=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++)
+    check_alloc(diff[i]=(double*)malloc(sizeof(double)*length));
+
+  pm=make_residuals(diff,coeff);
+  
+  if (stdo) {
+    avpm=pm[0]*pm[0];
+    for (i=1;i<dim;i++)
+      avpm += pm[i]*pm[i];
+    avpm=sqrt(avpm/dim);
+    printf("#average forcast error= %e\n",avpm);
+    printf("#individual forecast errors: ");
+    for (i=0;i<dim;i++)
+      printf("%e ",pm[i]);
+    printf("\n");
+    for (i=0;i<dim*poles;i++) {
+      printf("# ");
+      for (j=0;j<dim;j++)
+	printf("%e ",coeff[j][i]);
+      printf("\n");
+    }
+    if (!run_model || (verbosity&VER_USR1)) {
+      for (i=poles;i<length;i++) {
+	if (run_model)
+	  printf("#");
+	for (j=0;j<dim;j++)
+	  if (verbosity&VER_USR2)
+	    printf("%e %e ",series[j][i]+my_average[j],diff[j][i]);
+	  else
+	    printf("%e ",diff[j][i]);
+	printf("\n");
+      }
+    }
+    if (run_model && (ilength > 0))
+      iterate_model(coeff,pm,NULL);
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for output\n",outfile);
+    avpm=pm[0]*pm[0];
+    for (i=1;i<dim;i++)
+      avpm += pm[i]*pm[i];
+    avpm=sqrt(avpm/dim);
+    fprintf(file,"#average forcast error= %e\n",avpm);
+    fprintf(file,"#individual forecast errors: ");
+    for (i=0;i<dim;i++)
+      fprintf(file,"%e ",pm[i]);
+    fprintf(file,"\n");
+    for (i=0;i<dim*poles;i++) {
+      fprintf(file,"# ");
+      for (j=0;j<dim;j++)
+	fprintf(file,"%e ",coeff[j][i]);
+      fprintf(file,"\n");
+    }
+    if (!run_model || (verbosity&VER_USR1)) {
+      for (i=poles;i<length;i++) {
+	if (run_model)
+	  fprintf(file,"#");
+	for (j=0;j<dim;j++)
+	  if (verbosity&VER_USR2)
+	    fprintf(file,"%e %e ",series[j][i]+my_average[j],diff[j][i]);
+	  else
+	    fprintf(file,"%e ",diff[j][i]);
+	fprintf(file,"\n");
+      }
+    }
+    if (run_model && (ilength > 0))
+      iterate_model(coeff,pm,file);
+    fclose(file);
+  }
+
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  free(vec);
+  for (i=0;i<poles*dim;i++) {
+    free(mat[i]);
+    free(inverse[i]);
+  }
+  free(mat);
+  free(inverse);
+  for (i=0;i<dim;i++) {
+    free(coeff[i]);
+    free(diff[i]);
+  }
+  free(coeff);
+  free(diff);
+  free(pm);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/arima-model.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/arima-model.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,721 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, Last modified: Feb 6, 2006 */
+/*Changes:
+  Feb 4, 2006: First version
+  Feb 6, 2006: Find and remove bugs (1)
+  Feb 11, 2006: Add rand_arb_dist to iterate_***_model
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Fits an multivariate ARIMA model to the data and gives\
+ the coefficients\n\tand the residues (or an iterated model)"
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int dim=1,poles=10,ilength,ITER=50;
+unsigned int arpoles=0,ipoles=0,mapoles=0,offset;
+unsigned int verbosity=1;
+char *outfile=NULL,*column=NULL,stdo=1,dimset=0,run_model=0,arimaset=0;
+char *infile=NULL;
+double **series,convergence=1.0e-3;
+
+double *my_average;
+unsigned long ardim,armadim;
+unsigned int **aindex;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+	  " as a possible"
+	  " datafile.\nIf no datafile is given stdin is read. Just - also"
+	  " means stdin\n");
+  fprintf(stderr,"\t-l length of file [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-m dimension [default is 1]\n");
+  fprintf(stderr,"\t-c columns to read [default is 1,...,dimension]\n");
+  fprintf(stderr,"\t-p order of initial AR-Fit [default is %u]\n",poles);
+  fprintf(stderr,"\t-P order of AR,I,MA-Fit [default is %u,%u,%u]\n",
+	  arpoles,ipoles,mapoles);
+  fprintf(stderr,"\t-I # of arima iterations [default is %u]\n",ITER);
+  fprintf(stderr,"\t-e accuracy of convergence [default is %lf]\n",convergence);
+  fprintf(stderr,"\t-s length of iterated model [default no iteration]\n");
+  fprintf(stderr,"\t-o output file name [default is 'datafile'.ari]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+	  "0='only panic messages'\n\t\t"
+	  "1='+ input/output messages'\n\t\t"
+	  "2='+ print residuals though iterating a model'\n\t\t"
+	  "4='+ print original data plus residuals'\n");
+  fprintf(stderr,"\t-h show these options\n\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,argc,'p','u')) != NULL) {
+    sscanf(out,"%u",&poles);
+    if (poles < 1) {
+      fprintf(stderr,"The order should at least be one!\n");
+      exit(127);
+    }
+  }
+  if ((out=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,argc,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(argv,argc,'P','3')) != NULL) {
+    sscanf(out,"%u,%u,%u",&arpoles,&ipoles,&mapoles);
+    if ((arpoles+ipoles+mapoles)>0)
+      arimaset=1;
+  }
+  if ((out=check_option(argv,argc,'I','u')) != NULL)
+    sscanf(out,"%u",&ITER);
+  if ((out=check_option(argv,argc,'e','f')) != NULL)
+    sscanf(out,"%lf",&convergence);
+  if ((out=check_option(argv,argc,'c','u')) != NULL)
+    column=out;
+  if ((out=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,argc,'s','u')) != NULL) {
+    sscanf(out,"%u",&ilength);
+    run_model=1;
+  }
+  if ((out=check_option(argv,argc,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void make_difference(void)
+{
+  unsigned long i,d;
+
+  for (i=length-1;i>0;i--)
+    for (d=0;d<dim;d++)
+      series[d][i]=series[d][i]-series[d][i-1];
+}
+
+unsigned int** make_ar_index(void)
+{
+  unsigned int** ar_index;
+  unsigned long i;
+
+  check_alloc(ar_index=(unsigned int**)malloc(sizeof(unsigned int*)*2));
+  for (i=0;i<2;i++)
+    check_alloc(ar_index[i]=(unsigned int*)
+		malloc(sizeof(unsigned int)*ardim));
+  for (i=0;i<ardim;i++) {
+    ar_index[0][i]=i/poles;
+    ar_index[1][i]=i%poles;
+  }
+  return ar_index;
+}
+
+unsigned int** make_arima_index(unsigned int ars,unsigned int mas)
+{
+  unsigned int** arima_index;
+  unsigned int armad;
+  unsigned long i,i0;
+
+  armad=(ars+mas)*dim;
+  check_alloc(arima_index=(unsigned int**)malloc(sizeof(unsigned int*)*2));
+  for (i=0;i<2;i++)
+    check_alloc(arima_index[i]=(unsigned int*)
+		malloc(sizeof(unsigned int)*armad));
+  for (i=0;i<ars*dim;i++) {
+    arima_index[0][i]=i/ars;
+    arima_index[1][i]=i%ars;
+  }
+  i0=ars*dim;
+  for (i=0;i<mas*dim;i++) {
+    arima_index[0][i+i0]=dim+i/mas;
+    arima_index[1][i+i0]=i%mas;
+  }
+
+  return arima_index;
+}
+
+void set_averages_to_zero(void)
+{
+  double var;
+  long i,j;
+  
+  for (i=0;i<dim;i++) {
+    variance(series[i],length,&my_average[i],&var);
+    for (j=0;j<length;j++)
+      series[i][j] -= my_average[i];
+  }
+}
+
+double** build_matrix(double **mat,unsigned int size)
+{
+  long n,i,j,is,id,js,jd;
+  double norm;
+  
+  norm=1./((double)length-1.0-(double)poles-(double)offset);
+
+  for (i=0;i<size;i++) {
+    id=aindex[0][i];
+    is=aindex[1][i];
+    for (j=i;j<size;j++) {
+      jd=aindex[0][j];
+      js=aindex[1][j];
+      mat[i][j]=0.0;
+      for (n=offset+poles-1;n<length-1;n++)
+	mat[i][j] += series[id][n-is]*series[jd][n-js];
+      mat[i][j] *= norm;
+      mat[j][i]=mat[i][j];
+    }
+  }
+
+  return invert_matrix(mat,size);
+}
+
+void build_vector(double *vec,unsigned int size,long comp)
+{
+  long i,is,id,n;
+  double norm;
+
+  norm=1./((double)length-1.0-(double)poles-(double)offset);
+
+  for (i=0;i<size;i++) {
+    id=aindex[0][i];
+    is=aindex[1][i];
+    vec[i]=0.0;
+    for (n=offset+poles-1;n<length-1;n++)
+      vec[i] += series[comp][n+1]*series[id][n-is];
+    vec[i] *= norm;
+  }
+}
+
+double* multiply_matrix_vector(double **mat,double *vec,unsigned int size)
+{
+  long i,j;
+  double *new_vec;
+
+  check_alloc(new_vec=(double*)malloc(sizeof(double)*size));
+
+  for (i=0;i<size;i++) {
+    new_vec[i]=0.0;
+    for (j=0;j<size;j++)
+      new_vec[i] += mat[i][j]*vec[j];
+  }
+
+  return new_vec;
+}
+
+double* make_residuals(double **diff,double **coeff,unsigned int size)
+{
+  long n,n1,d,i,is,id;
+  double *resi;
+  
+  check_alloc(resi=(double*)malloc(sizeof(double)*dim));
+  for (i=0;i<dim;i++)
+    resi[i]=0.0;
+
+  for (n=poles-1;n<length-1;n++) {
+    n1=n+1;
+    for (d=0;d<dim;d++) {
+      diff[d][n1]=series[d][n1];
+      for (i=0;i<size;i++) {
+	id=aindex[0][i];
+	is=aindex[1][i];
+	diff[d][n1] -= coeff[d][i]*series[id][n-is];
+      }
+      resi[d] += sqr(diff[d][n1]);
+    }
+  }
+
+  for (i=0;i<dim;i++)
+    resi[i]=sqrt(resi[i]/((double)length-(double)poles));
+
+  return resi;
+}
+
+void iterate_model(double **coeff,double *sigma,double **diff,FILE *file)
+{
+  long i,j,i1,i2,n,d;
+  double **iterate,*swap,**myrand;
+  
+  check_alloc(iterate=(double**)malloc(sizeof(double*)*(poles+1)));
+  for (i=0;i<=poles;i++)
+    check_alloc(iterate[i]=(double*)malloc(sizeof(double)*dim));
+
+  check_alloc(myrand=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++)
+    myrand[i]=rand_arb_dist(diff[i],length,ilength+poles,100,0x44325);
+
+  rnd_init(0x44325);
+  for (i=0;i<1000;i++)
+    rnd_long();
+  for (i=0;i<dim;i++)
+    for (j=0;j<poles;j++)
+      iterate[j][i]=myrand[i][j];
+  
+  for (n=0;n<ilength;n++) {
+    for (d=0;d<dim;d++) {
+      iterate[poles][d]=myrand[d][n+poles];
+      for (i1=0;i1<dim;i1++)
+	for (i2=0;i2<poles;i2++)
+	  iterate[poles][d] += coeff[d][i1*poles+i2]*iterate[poles-1-i2][i1];
+    }
+    if (file != NULL) {
+      for (d=0;d<dim;d++)
+	fprintf(file,"%e ",iterate[poles][d]);
+      fprintf(file,"\n");
+    }
+    else {
+      for (d=0;d<dim;d++)
+	printf("%e ",iterate[poles][d]);
+      printf("\n");
+    }
+
+    swap=iterate[0];
+    for (i=0;i<poles;i++)
+      iterate[i]=iterate[i+1];
+    iterate[poles]=swap;
+  }
+
+  for (i=0;i<=poles;i++)
+    free(iterate[i]);
+  free(iterate);
+
+  for (i=0;i<dim;i++)
+    free(myrand[i]);
+  free(myrand);
+}
+
+void iterate_arima_model(double **coeff,double *sigma,double **diff,FILE *file)
+{
+  double **iterate,*swap,**myrand;
+  unsigned long i,j,n,is,id;
+
+  check_alloc(iterate=(double**)malloc(sizeof(double*)*(poles+1)));
+  for (i=0;i<=poles;i++)
+    check_alloc(iterate[i]=(double*)malloc(sizeof(double)*2*dim));
+
+  check_alloc(myrand=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++)
+    myrand[i]=rand_arb_dist(diff[i],length,ilength+poles,100,0x44325);
+
+  rnd_init(0x44325);
+  for (i=0;i<1000;i++)
+    rnd_long();
+  for (i=0;i<dim;i++)
+    for (j=0;j<poles;j++)
+      iterate[j][i]=iterate[j][dim+i]=myrand[i][j];
+
+  for (n=0;n<ilength;n++) {
+    for (i=0;i<dim;i++)
+      iterate[poles][i]=iterate[poles][i+dim]=myrand[i][n+poles];
+
+    for (j=0;j<dim;j++) {
+      for (i=0;i<armadim;i++) {
+	id=aindex[0][i];
+	is=aindex[1][i];
+	iterate[poles][j] += coeff[j][i]*iterate[poles-1-is][id];
+      }
+    }
+
+    if (file != NULL) {
+      for (i=0;i<dim;i++)
+	fprintf(file,"%e ",iterate[poles][i]);
+      fprintf(file,"\n");
+    }
+    else {
+      for (i=0;i<dim;i++)
+	printf("%e ",iterate[poles][i]);
+      printf("\n");
+    }
+
+    swap=iterate[0];
+    for (i=0;i<poles;i++)
+      iterate[i]=iterate[i+1];
+    iterate[poles]=swap;
+  }
+
+  for (i=0;i<=poles;i++)
+    free(iterate[i]);
+  free(iterate);
+  for (i=0;i<dim;i++)
+    free(myrand[i]);
+  free(myrand);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  double *pm;
+  long i,j,iter,hj,realiter=0;
+  unsigned int size,is,id;
+  FILE *file;
+  double **mat,**inverse,*vec,**coeff,**diff,**hseries;
+  double **oldcoeff,*diffcoeff=NULL;
+  double hdiff,**xdiff=NULL,avpm;
+  double loglikelihood,aic,alldiff;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".ari");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.ari");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,column,
+				      dimset,verbosity);
+
+  check_alloc(my_average=(double*)malloc(sizeof(double)*dim));
+
+  for (i=0;i<ipoles;i++)
+    make_difference();
+
+  for (i=0;i<dim;i++)
+    series[i] += ipoles;
+  length -= ipoles;
+
+  set_averages_to_zero();
+
+  if (poles >= length) {
+    fprintf(stderr,"It makes no sense to have more poles than data! Exiting\n");
+    exit(AR_MODEL_TOO_MANY_POLES);
+  }
+  if (arimaset) {
+    if ((arpoles >= length) || (mapoles >= length)) {
+      fprintf(stderr,"It makes no sense to have more poles than data! Exiting\n");
+      exit(AR_MODEL_TOO_MANY_POLES);
+    }
+  }
+ 
+  ardim=poles*dim;
+  aindex=make_ar_index();
+
+  check_alloc(vec=(double*)malloc(sizeof(double)*ardim));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*ardim));
+  for (i=0;i<ardim;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*ardim));
+
+  check_alloc(coeff=(double**)malloc(sizeof(double*)*dim));
+  inverse=build_matrix(mat,ardim);
+  for (i=0;i<dim;i++) {
+    build_vector(vec,ardim,i);
+    coeff[i]=multiply_matrix_vector(inverse,vec,ardim);
+  }
+
+  check_alloc(diff=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++)
+    check_alloc(diff[i]=(double*)malloc(sizeof(double)*length));
+
+  pm=make_residuals(diff,coeff,ardim);
+
+  free(vec);
+  for (i=0;i<ardim;i++) {
+    free(mat[i]);
+    free(inverse[i]);
+  }
+  free(mat);
+  free(inverse);
+  size=ardim;
+  
+  if (arimaset) {
+    offset=poles;
+    for (i=0;i<2;i++)
+      free(aindex[i]);
+    free(aindex);
+
+    for (i=0;i<dim;i++)
+      free(coeff[i]);
+    free(coeff);
+    check_alloc(xdiff=(double**)malloc(sizeof(double*)*ITER));
+    for (i=0;i<ITER;i++)
+      check_alloc(xdiff[i]=(double*)malloc(sizeof(double)*dim));
+
+    armadim=(arpoles+mapoles)*dim;
+    aindex=make_arima_index(arpoles,mapoles);
+    size=armadim;
+
+    check_alloc(hseries=(double**)malloc(sizeof(double*)*2*dim));
+    for (i=0;i<dim;i++) {
+      check_alloc(hseries[i]=(double*)malloc(sizeof(double)*length));
+      check_alloc(hseries[i+dim]=(double*)malloc(sizeof(double)*length));
+      for (j=0;j<length;j++) {
+	hseries[i][j]=series[i][j];
+	hseries[i+dim][j]=diff[i][j];
+      }
+    }
+
+    for (i=0;i<dim;i++)
+      free(series[i]-ipoles);
+    free(series);
+
+    series=hseries;
+
+    check_alloc(oldcoeff=(double**)malloc(sizeof(double*)*dim));
+    for (i=0;i<dim;i++) {
+      check_alloc(oldcoeff[i]=(double*)malloc(sizeof(double)*armadim));
+      for (j=0;j<armadim;j++)
+	oldcoeff[i][j]=0.0;
+    }
+    check_alloc(diffcoeff=(double*)malloc(sizeof(double)*ITER));
+
+    for (iter=1;iter<=ITER;iter++) {
+      check_alloc(vec=(double*)malloc(sizeof(double)*armadim));
+      check_alloc(mat=(double**)malloc(sizeof(double*)*armadim));
+      for (i=0;i<armadim;i++)
+	check_alloc(mat[i]=(double*)malloc(sizeof(double)*armadim));
+
+      check_alloc(coeff=(double**)malloc(sizeof(double*)*dim));
+
+      poles=(arpoles > mapoles)? arpoles:mapoles;
+
+      offset += poles;
+      inverse=build_matrix(mat,armadim);
+
+      for (i=0;i<dim;i++) {
+	build_vector(vec,armadim,i);
+	coeff[i]=multiply_matrix_vector(inverse,vec,armadim);
+      }
+
+      pm=make_residuals(diff,coeff,armadim);
+
+      for (j=0;j<dim;j++) {
+	hdiff=0.0;
+	hj=j+dim;
+	for (i=offset;i<length;i++)
+	  hdiff += sqr(series[hj][i]-diff[j][i]);
+	for (i=0;i<length;i++) {
+	  series[hj][i]=diff[j][i];
+	}
+	xdiff[iter-1][j]=sqrt(hdiff/(double)(length-offset));
+      }
+
+      free(vec);
+      for (i=0;i<armadim;i++) {
+	free(mat[i]);
+	free(inverse[i]);
+      }
+      free(mat);
+      free(inverse);
+
+      diffcoeff[iter-1]=0.0;
+      for (i=0;i<dim;i++)
+	for (j=0;j<dim;j++) {
+	  diffcoeff[iter-1] += sqr(coeff[i][j]-oldcoeff[i][j]);
+	  oldcoeff[i][j]=coeff[i][j];
+	}
+      diffcoeff[iter-1]=sqrt(diffcoeff[iter-1]/(double)armadim);
+      alldiff=xdiff[iter-1][0];
+      for (i=1;i<dim;i++)
+	if (xdiff[iter-1][i] > alldiff)
+	  alldiff=xdiff[iter-1][i];
+      realiter=iter;
+      if (alldiff < convergence)
+	iter=ITER;
+  
+      if (iter < ITER) {
+	for (i=0;i<dim;i++)
+	  free(coeff[i]);
+	free(coeff);
+      }
+    }
+  }
+
+  if (stdo) {
+    if (arimaset) {
+      printf("#convergence of residuals in arima fit\n");
+      for (i=0;i<realiter;i++) {
+	printf("#iteration %ld ",i+1);
+	for (j=0;j<dim;j++)
+	  printf("%e ",xdiff[i][j]);
+	printf("%e",diffcoeff[i]);
+	printf("\n");
+      }
+    }
+    avpm=pm[0]*pm[0];
+    loglikelihood= -log(pm[0]);
+    for (i=1;i<dim;i++) {
+      avpm += pm[i]*pm[i];
+      loglikelihood -= log(pm[i]);
+    }
+    loglikelihood *= ((double)length);
+    loglikelihood += -((double)length)*
+      ((1.0+log(2.*M_PI))*dim)/2.0;
+    avpm=sqrt(avpm/dim);
+    printf("#average forcast error= %e\n",avpm);
+    printf("#individual forecast errors: ");
+     for (i=0;i<dim;i++)
+      printf("%e ",pm[i]);
+    printf("\n");
+    if (arimaset)
+      aic=2.0*(arpoles+mapoles)-2.0*loglikelihood;
+    else
+      aic=2.0*poles-2.0*loglikelihood;
+    printf("#Log-Likelihood= %e\t AIC= %e\n",loglikelihood,aic);
+    for (i=0;i<size;i++) {
+      id=aindex[0][i];
+      is=aindex[1][i];
+      if (id < dim)
+	printf("#x_%u(n-%u) ",id+1,is);
+      else
+	printf("#e_%u(n-%u) ",id+1-dim,is);
+      for (j=0;j<dim;j++)
+	printf("%e ",coeff[j][i]);
+      printf("\n");
+    }
+    if (!run_model || (verbosity&VER_USR1)) {
+      for (i=poles;i<length;i++) {
+	if (run_model)
+	  printf("#");
+	for (j=0;j<dim;j++)
+	  if (verbosity&VER_USR2)
+	    printf("%e %e ",series[j][i]+my_average[j],diff[j][i]);
+	  else
+	    printf("%e ",diff[j][i]);
+	printf("\n");
+      }
+    }
+    if (run_model && (ilength > 0)) {
+      if (!arimaset)
+	iterate_model(coeff,pm,diff,NULL);
+      else 
+	iterate_arima_model(coeff,pm,diff,NULL);
+    }
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for output\n",outfile);
+    if (arimaset) {
+      fprintf(file,"#convergence of residuals in arima fit\n");
+      for (i=0;i<realiter;i++) {
+	fprintf(file,"#iteration %ld ",i+1);
+	for (j=0;j<dim;j++)
+	  fprintf(file,"%e ",xdiff[i][j]);
+	fprintf(file,"%e",diffcoeff[i]);
+	fprintf(file,"\n");
+      }
+    }
+    avpm=pm[0]*pm[0];
+    loglikelihood= -log(pm[0]);
+    for (i=1;i<dim;i++) {
+      avpm += pm[i]*pm[i];
+      loglikelihood -= log(pm[i]);
+    }
+    loglikelihood *= ((double)length);
+    loglikelihood += -((double)length)*
+      ((1.0+log(2.*M_PI))*dim)/2.0;
+    avpm=sqrt(avpm/dim);
+    fprintf(file,"#average forcast error= %e\n",avpm);
+    fprintf(file,"#individual forecast errors: ");
+    for (i=0;i<dim;i++)
+      fprintf(file,"%e ",pm[i]);
+    fprintf(file,"\n");
+    if (arimaset)
+      aic=2.0*(arpoles+mapoles)-2.0*loglikelihood;
+    else
+      aic=2.0*poles-2.0*loglikelihood;
+    fprintf(file,"#Log-Likelihood= %e\t AIC= %e\n",loglikelihood,aic);
+    for (i=0;i<size;i++) {
+      id=aindex[0][i];
+      is=aindex[1][i];
+      if (id < dim)
+	fprintf(file,"#x_%u(n-%u) ",id+1,is);
+      else
+	fprintf(file,"#e_%u(n-%u) ",id+1-dim,is);
+      for (j=0;j<dim;j++)
+	fprintf(file,"%e ",coeff[j][i]);
+      fprintf(file,"\n");
+    }
+    if (!run_model || (verbosity&VER_USR1)) {
+      for (i=poles;i<length;i++) {
+	if (run_model)
+	  fprintf(file,"#");
+	for (j=0;j<dim;j++)
+	  if (verbosity&VER_USR2)
+	    fprintf(file,"%e %e ",series[j][i]+my_average[j],diff[j][i]);
+	  else
+	    fprintf(file,"%e ",diff[j][i]);
+	fprintf(file,"\n");
+      }
+    }
+    if (run_model && (ilength > 0)) {
+      if (!arimaset)
+	iterate_model(coeff,pm,diff,file);
+      else
+	iterate_arima_model(coeff,pm,diff,file);
+    }
+    fclose(file);
+  }
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  for (i=0;i<dim;i++) {
+    free(coeff[i]);
+    free(diff[i]);
+    free(series[i]);
+    if (arimaset)
+      free(series[i+dim]);
+  }
+  free(coeff);
+  free(diff);
+  free(series);
+
+  free(pm);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/av-d2.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/av-d2.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,188 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 3, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Smoothes the output of the d2 program"
+
+#define MAXLENGTH 1000
+
+unsigned int maxdim=UINT_MAX,mindim=1;
+unsigned int verbosity=0xff;
+int aver=1;
+char rescaled=0;
+char stout=1;
+char *outfile=NULL;
+char *infile=NULL;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible datafile.\nStdin does NOT work.\n");
+  fprintf(stderr,"\t-m dimension to start with [Default: 1]\n");
+  fprintf(stderr,"\t-M dimension to end with [Default: whole file]\n");
+  fprintf(stderr,"\t-a n average over (2n+1) values [Default: 1]\n");
+  fprintf(stderr,"\t-E use rescaled data for the length scales\n\t\t"
+	  "[Default: use units of data]\n");
+  fprintf(stderr,"\t-o name of output file [Default: stdout,\n\t\t"
+	  "-o without value means 'datafile'.av]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+  
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&mindim);
+  if ((out=check_option(in,n,'M','u')) != NULL)
+    sscanf(out,"%u",&maxdim);
+  if ((out=check_option(in,n,'a','u')) != NULL)
+    sscanf(out,"%u",&aver);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'E','n')) != NULL)
+    rescaled=1;
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char instr[1024];
+  char *form1="%lf%lf",*form2="%*lf%lf%lf";
+  char empty=0;
+  unsigned int howmany,size=1;
+  int j,k;
+  long dim;
+  double *eps,*y;
+  double avy,aveps,norm;
+  FILE *file,*fout=NULL;
+
+  if ((argc < 2) || scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,0L,verbosity);
+  if (infile == NULL) {
+    fprintf(stderr,"You have to give a datafile. Exiting!\n");
+    exit(127);
+  }
+  if (outfile == NULL) {
+    check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+    sprintf(outfile,"%s.av",infile);
+  }
+  
+  check_alloc(eps=(double*)malloc(sizeof(double)*MAXLENGTH));
+  check_alloc(y=(double*)malloc(sizeof(double)*MAXLENGTH));
+  
+  file=fopen(infile,"r");
+  
+  if (!stout) {
+    test_outfile(outfile);
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  if (mindim > maxdim)
+    mindim=maxdim;
+  norm=2.0*aver+1.0;
+
+  while (fgets(instr,1024,file) != NULL) {
+    if (strlen(instr) != 1) {
+      if (instr[0] == '#') {
+	if (strstr(instr,"m= ") != NULL) {
+	  sscanf(instr,"%*s %ld",&dim);
+	  if ((dim >= mindim) && (dim <= maxdim)) {
+	    howmany=0;
+	    empty=0;
+	    do {
+	      if (fgets(instr,1024,file) == NULL)
+		exit(127);
+	      if (strlen(instr) == 1)
+		empty=1;
+	      if (!empty && (instr[0] != '#')) {
+		if (!rescaled)
+		  sscanf(instr,form1,&eps[howmany],&y[howmany]);
+		else
+		  sscanf(instr,form2,&y[howmany],&eps[howmany]);
+		howmany++;
+		if (!(howmany%MAXLENGTH)) {
+		  check_alloc(realloc(eps,size*MAXLENGTH*sizeof(double)));
+		  check_alloc(realloc(y,size*MAXLENGTH*sizeof(double)));
+		  size++;
+		}
+	      }
+	    } while (!empty);
+	    for (k=aver;k<howmany-aver;k++) {
+	      avy=aveps=0.0;
+	      for (j= -aver;j<=aver;j++) {
+		avy += y[k+j];
+		aveps += eps[k+j];
+	      }
+	      if (!stout)
+		fprintf(fout,"%e %e\n",aveps/norm,avy/norm);
+	      else
+		fprintf(stdout,"%e %e\n",aveps/norm,avy/norm);
+	    }
+	    if (!stout)
+	      fprintf(fout,"\n");
+	    else
+	      fprintf(stdout,"\n");
+	  }
+	}
+      }
+    }
+  }
+
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  free(eps);
+  free(y);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/boxcount.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/boxcount.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,369 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/* Author: Rainer Hegger Last modified: Feb 22, 2006 */
+/* Changes: 
+   02/22/06: Remove this strange else in start_box that 
+             did not compile anyways
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the Renyi entropy of Qth order\n\t\
+using a partition instead of a covering."
+
+typedef struct {
+  double *hist;
+  void *ptr;
+} hliste;
+
+unsigned long LENGTH=ULONG_MAX,exclude=0;
+unsigned int maxembed=10,dimension=1,DELAY=1,EPSCOUNT=20;
+unsigned int verbosity=0xff;
+double Q=2.0,EPSMIN=1.e-3,EPSMAX=1.0;
+char dimset=0,epsminset=0,epsmaxset=0;
+char *outfile=NULL;
+char *column=NULL;
+
+int epsi;
+unsigned long length;
+double EPSFAKTOR;
+unsigned int **which_dims;
+double *histo;
+double **series;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [Options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"\t-l # of datapoints [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [Default: %lu]\n",exclude);
+  fprintf(stderr,"\t-M # of columns,maximal embedding dimension "
+	  "[Default: %u,%u]\n",dimension,maxembed);
+  fprintf(stderr,"\t-c columns to read  [Default: 1,...,#of compon.]\n");
+  fprintf(stderr,"\t-d delay [Default: %u]\n",DELAY);
+  fprintf(stderr,"\t-Q order of the Renyi entropy [Default: %.1f]\n",Q);
+  fprintf(stderr,"\t-r minimal epsilon [Default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-R maximal epsilon [Default: data interval]\n");
+  fprintf(stderr,"\t-# # of epsilons to use [Default: %u]\n",EPSCOUNT);
+  fprintf(stderr,"\t-o output file name [Default: 'datafile'.box]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+  
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'M','2')) != NULL) {
+    sscanf(out,"%u,%u",&dimension,&maxembed);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'Q','f')) != NULL)
+    sscanf(out,"%lf",&Q);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    sscanf(out,"%lf",&EPSMIN);
+    epsminset=1;
+  }
+  if ((out=check_option(in,n,'R','f')) != NULL) {
+    sscanf(out,"%lf",&EPSMAX);
+    epsmaxset=1;
+  }
+  if ((out=check_option(in,n,'#','u')) != NULL)
+    sscanf(out,"%u",&EPSCOUNT);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','s')) != NULL)
+    outfile=out;
+}
+
+hliste *make_histo(void)
+{
+  int i;
+  hliste *element;
+  
+  check_alloc(element=(hliste*)malloc(sizeof(hliste)));
+  element->ptr=NULL;
+  check_alloc(element->hist=(double*)malloc(sizeof(double)*maxembed*dimension));
+  for (i=0;i<maxembed*dimension;i++)
+    element->hist[i]=0.0;
+  
+  return element;
+}
+
+void next_dim(int wd,int n,unsigned int *first)
+{
+  int i,which,d1,comp;
+  double epsinv,norm,p;
+  unsigned int **act;
+  int *found,hf;
+
+  comp=which_dims[wd][0];
+  d1=which_dims[wd][1]*DELAY;
+
+  epsinv=(double)epsi;
+  norm=(double)length;
+
+  check_alloc(act=(unsigned int**)malloc(epsi*sizeof(int*)));
+  check_alloc(found=(int*)malloc(epsi*sizeof(int)));
+  
+  for (i=0;i<epsi;i++) {
+    found[i]=0;
+    act[i]=NULL;
+  }
+  
+  for (i=0;i<n;i++) {
+    which=(int)(series[comp][first[i]+d1]*epsinv);
+    hf= ++found[which];
+    check_alloc(act[which]=
+		realloc((unsigned int*)act[which],hf*sizeof(unsigned int)));
+    act[which][hf-1]=first[i];
+  }
+  
+  for (i=0;i<epsi;i++)
+    if (found[i]) {
+      p=(double)(found[i])/(norm);
+      if (Q == 1.0)
+	histo[wd] -= p*log(p);
+      else
+	histo[wd] += pow(p,Q);
+    }
+  
+  if (wd<(maxembed*dimension-1))
+    for (i=0;i<epsi;i++)
+      if (found[i])
+	next_dim(wd+1,found[i],act[i]);
+  
+  for (i=0;i<epsi;i++)
+    if (found[i])
+      free(act[i]);
+  
+  free(act);
+  free(found);
+}
+
+void start_box(void)
+{
+  int i,which;
+  double epsinv,norm,p;
+  unsigned int **act;
+  int *found,hf;
+  void next_dim();
+  
+  epsinv=(double)epsi;
+  norm=(double)length;
+  
+  check_alloc(act=(unsigned int**)malloc(epsi*sizeof(int*)));
+  check_alloc(found=(int*)malloc(epsi*sizeof(int)));
+  
+  for (i=0;i<epsi;i++) {
+    found[i]=0;
+    act[i]=NULL;
+  }
+  
+  for (i=0;i<length;i++) {
+    which=(int)(series[0][i]*epsinv);
+    hf= ++found[which];
+    check_alloc(act[which]=
+		realloc((unsigned int*)act[which],hf*sizeof(unsigned int)));
+    act[which][hf-1]=i;
+  }
+  
+  for (i=0;i<epsi;i++)
+    if (found[i]) {
+      p=(double)(found[i])/(norm);
+      if (Q == 1.0)
+	histo[0] -= p*log(p);
+      else
+	histo[0] += pow(p,Q);
+    }
+  
+  if (1<dimension*maxembed) {
+    for (i=0;i<epsi;i++) {
+      if (found[i])
+	next_dim(1,found[i],act[i]);
+    }
+  }
+  /*
+  else {
+    if (1<maxembed)
+      for (i=0;i<epsi;i++) {
+	if (found[i])
+	  next_dim(1,found[i],act[i]);
+      }
+  }
+  */
+
+  for (i=0;i<epsi;i++)
+    if (found[i])
+      free(act[i]);
+  
+  free(act);
+  free(found);
+}
+
+int main(int argc,char **argv)
+{
+  int i,j,k,count,epsi_old=0,epsi_test;
+  void *root;
+  hliste *histo_el;
+  double *deps,heps;
+  double min,interval,maxinterval;
+  char *infile=NULL,stdi=0;
+  FILE *fHq;
+
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.box",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.box");
+    }
+  }
+  test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dimension,"",
+				      dimset,verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dimension,
+				      column,dimset,verbosity);
+  maxinterval=0.0;
+  for (i=0;i<dimension;i++) {
+    rescale_data(series[i],LENGTH,&min,&interval);
+    if (interval > maxinterval)
+      maxinterval=interval;
+  }
+  if (epsminset)
+    EPSMIN /= maxinterval;
+  if (epsmaxset)
+    EPSMAX /= maxinterval;
+  for (i=0;i<dimension;i++) {
+    for (j=0;j<LENGTH;j++)
+      if (series[i][j] >= 1.0)
+	series[i][j] -= EPSMIN/2.0;
+  }
+
+  check_alloc(histo=(double*)malloc(sizeof(double)*maxembed*dimension));
+  check_alloc(deps=(double*)malloc(sizeof(double)*EPSCOUNT));
+  check_alloc(which_dims=(unsigned int**)malloc(sizeof(int*)*
+						maxembed*dimension));
+  for (i=0;i<maxembed*dimension;i++)
+    check_alloc(which_dims[i]=(unsigned int*)malloc(sizeof(int)*2));
+  for (i=0;i<maxembed;i++)
+    for (j=0;j<dimension;j++) {
+      which_dims[i*dimension+j][0]=j;
+      which_dims[i*dimension+j][1]=i;
+    }
+  
+  histo_el=make_histo();
+  root=histo_el;
+  
+  if (EPSCOUNT >1)
+    EPSFAKTOR=pow(EPSMAX/EPSMIN,1.0/(double)(EPSCOUNT-1));
+  else
+    EPSFAKTOR=1.0;
+
+  length=LENGTH-(maxembed-1)*DELAY;
+
+  heps=EPSMAX*EPSFAKTOR;
+  
+  for (k=0;k<EPSCOUNT;k++) {
+    count++;
+    for (i=0;i<maxembed*dimension;i++)
+      histo[i]=0.0;
+    do {
+      heps /= EPSFAKTOR;
+      epsi_test=(int)(1./heps);
+    } while (epsi_test <= epsi_old);
+    
+    epsi=epsi_test;
+    epsi_old=epsi;
+    deps[k]=heps;
+    
+    start_box();
+    histo_el=root;
+    while (histo_el->ptr != NULL)
+      histo_el=histo_el->ptr;
+    
+    for (i=0;i<maxembed*dimension;i++)
+      if (Q == 1.0)
+	histo_el->hist[i]=histo[i];
+      else
+	histo_el->hist[i]=log(histo[i])/(1.0-Q);
+    
+    histo_el->ptr=make_histo();
+    histo_el=histo_el->ptr;
+    fHq=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+
+    for (i=0;i<maxembed*dimension;i++) {
+      fprintf(fHq,"#component = %d embedding = %d\n",which_dims[i][0]+1,
+	      which_dims[i][1]+1);
+      histo_el=root;
+      for (j=0;j<=k;j++) {
+	if (i == 0)
+	  fprintf(fHq,"%e %e %e\n",deps[j]*maxinterval,
+		  histo_el->hist[i],histo_el->hist[i]);
+	else
+	  fprintf(fHq,"%e %e %e\n",deps[j]*maxinterval,
+		  histo_el->hist[i],histo_el->hist[i]-histo_el->hist[i-1]);
+	histo_el=histo_el->ptr;
+      }
+      fprintf(fHq,"\n");
+    }
+    fclose(fHq);
+  }
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/corr.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/corr.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,179 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 3, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the autocorrelations of a data set"
+
+char *format,*outfile=NULL,stout=1,normalize=1;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+unsigned long tau=100,length=ULONG_MAX,exclude=0;
+double *array;
+double av,var;
+char *infile=NULL;
+
+void show_options(char *progname) 
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l length [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default 0]\n");
+  fprintf(stderr,"\t-c column to read [default is 1]\n");
+  fprintf(stderr,"\t-D corrlength  [default is 100]\n");
+  fprintf(stderr,"\t-n don\'t normalize to the variance"
+	  " of the data [not set]\n");
+  fprintf(stderr,"\t-o output_file  [default is 'datafile'.cor; no -o"
+  " means stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,argc,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(argv,argc,'D','u')) != NULL)
+    sscanf(out,"%lu",&tau);
+  if ((out=check_option(argv,argc,'n','n')) != NULL)
+    normalize=0;
+  if ((out=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,argc,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double corr(long i)
+{
+  long j;
+  double c=0.0;
+  
+  for (j=0;j<(length-i);j++)
+    c += array[j]*array[j+i];
+
+  return c/(length-i);
+}
+
+int main(int argc,char** argv)
+{
+  char stdi=0;
+  long i;
+  FILE *fout=NULL;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".cor");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.cor");
+    }
+  }
+  if (!stout)
+    test_outfile(outfile);
+
+  array=(double*)get_series(infile,&length,exclude,column,verbosity);
+
+  if (tau >= length)
+    tau=length-1;
+
+  variance(array,length,&av,&var);
+
+  if (normalize) {
+    for (i=0;i<length;i++)
+      array[i] -= av;
+  }
+
+  if (!stout) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(fout,"# average=%e\n",av);
+    fprintf(fout,"# standard deviation=%e\n",var);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"# average=%e\n",av);
+    fprintf(stdout,"# standard deviation=%e\n",var);
+  }
+  if (normalize)
+    var *= var;
+  else
+    var=1.0;
+
+  for (i=0;i<=tau;i++)
+    if (!stout) {
+      fprintf(fout,"%ld %e\n",i,corr(i)/var);
+      fflush(fout);
+    }
+    else {
+      fprintf(stdout,"%ld %e\n",i,corr(i)/var);
+      fflush(stdout);
+    }
+  if (!stout)
+    fclose(fout);
+
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  free(array);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/d2.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/d2.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,587 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified May 10, 2000 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include <time.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the correlation sum, -dimension and -entropy"
+
+/* output is written every WHEN seconds */
+#define WHEN 120
+/* Size of the field for box assisted neighbour searching 
+   (has to be a power of 2)*/
+#define NMAX 256
+/* Size of the box for the scramble routine */
+#define SCBOX 4096
+
+double **series;
+long *scr;
+char dimset=0,rescale_set=0,eps_min_set=0,eps_max_set=0;
+char *FOUT=NULL;
+double epsfactor,epsinv,lneps,lnfac;
+double EPSMAX=1.0,EPSMIN=1.e-3;
+double min,interval;
+int imax=NMAX-1,howoften1,imin;
+long box[NMAX][NMAX],*list,boxc1[NMAX],*listc1;
+unsigned long nmax;
+double **found,*norm;
+unsigned long MINDIST=0,MAXFOUND=1000;
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int DIM=1,EMBED=10,HOWOFTEN=100,DELAY=1;
+unsigned int verbosity=0x1;
+char *column=NULL;
+char *infile=NULL;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"  Usage: %s [options]\n",progname);
+  fprintf(stderr,"  Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l datapoints [default is whole file]\n");
+  fprintf(stderr,"\t-x exclude # points [default 0]\n");
+  fprintf(stderr,"\t-d delay  [default 1]\n");
+  fprintf(stderr,"\t-M # of components, max. embedding dim. [default 1,10]\n");
+  fprintf(stderr,"\t-c columns [default 1,...,# of components]\n");
+  fprintf(stderr,"\t-t theiler-window [default 0]\n");
+  fprintf(stderr,"\t-R max-epsilon "
+	  "[default: max data interval]\n");
+  fprintf(stderr,"\t-r min-epsilon [default: (max data interval)/1000]\n");
+  fprintf(stderr,"\t-# #-of-epsilons [default 100]\n");
+  fprintf(stderr,"\t-N max-#-of-pairs (0 means all) [default 1000]\n");
+  fprintf(stderr,"\t-E use rescaled data [default: not rescaled]\n");
+  fprintf(stderr," \t-o outfiles"
+	  " [without exts.! default datafile[.d2][.h2][.stat][.c2]]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+	  "2='+ output message each time output is done\n");
+  
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char **argv)
+{
+  char *out;
+  
+  if ((out=check_option(argv,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(argv,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(argv,n,'M','2')) != NULL) {
+    sscanf(out,"%u,%u",&DIM,&EMBED);
+    dimset=1;
+  }
+  if ((out=check_option(argv,n,'t','u')) != NULL)
+    sscanf(out,"%lu",&MINDIST);
+  if ((out=check_option(argv,n,'R','f')) != NULL) {
+    sscanf(out,"%lf",&EPSMAX);
+    eps_max_set=1;
+  }
+  if ((out=check_option(argv,n,'r','f')) != NULL) {
+    sscanf(out,"%lf",&EPSMIN);
+    eps_min_set=1;
+  }
+  if ((out=check_option(argv,n,'#','u')) != NULL)
+    sscanf(out,"%u",&HOWOFTEN);
+  if ((out=check_option(argv,n,'N','u')) != NULL) {
+    sscanf(out,"%lu",&MAXFOUND);
+    if (MAXFOUND == 0)
+      MAXFOUND=ULONG_MAX;
+  }
+  if ((out=check_option(argv,n,'E','n')) != NULL)
+    rescale_set=1;
+  if ((out=check_option(argv,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,n,'o','o')) != NULL)
+    if (strlen(out) > 0)
+      FOUT=out;
+}
+      
+void scramble(void)
+{
+  long i,j,k,m;
+  unsigned long rnd,rndf,hlength,allscr=0;
+  long *scfound,*scnhelp,scnfound;
+  long scbox[SCBOX],lswap,element,scbox1=SCBOX-1;
+  double *rz,*schelp,sceps=(double)SCBOX-0.001,swap;
+  
+  hlength=length-(EMBED-1)*DELAY;
+
+  if (sizeof(long) == 8) {
+    rndf=13*13*13*13;
+    rndf=rndf*rndf*rndf*13;
+    rnd=0x849178L;
+  }
+  else {
+    rndf=69069;
+    rnd=0x234571L;
+  }
+  for (i=0;i<1000;i++)
+    rnd=rnd*rndf+1;
+
+  check_alloc(rz=(double*)malloc(sizeof(double)*hlength));
+  check_alloc(scfound=(long*)malloc(sizeof(long)*hlength));
+  check_alloc(scnhelp=(long*)malloc(sizeof(long)*hlength));
+  check_alloc(schelp=(double*)malloc(sizeof(double)*hlength));
+
+  for (i=0;i<hlength;i++)
+    rz[i]=(double)(rnd=rnd*rndf+1)/ULONG_MAX;
+  
+  for (i=0;i<SCBOX;i++)
+    scbox[i]= -1;
+  for (i=0;i<hlength;i++) {
+    m=(int)(rz[i]*sceps)&scbox1;
+    scfound[i]=scbox[m];
+    scbox[m]=i;
+  }
+  for (i=0;i<SCBOX;i++) {
+    scnfound=0;
+    element=scbox[i];
+    while(element != -1) {
+      scnhelp[scnfound]=element;
+      schelp[scnfound++]=rz[element];
+      element=scfound[element];
+    }
+    
+    for (j=0;j<scnfound-1;j++)
+      for (k=j+1;k<scnfound;k++)
+	if (schelp[k] < schelp[j]) {
+	  swap=schelp[k];
+	  schelp[k]=schelp[j];
+	  schelp[j]=swap;
+	  lswap=scnhelp[k];
+	  scnhelp[k]=scnhelp[j];
+	  scnhelp[j]=lswap;
+	}
+    for (j=0;j<scnfound;j++)
+      scr[allscr+j]=scnhelp[j];
+    allscr += scnfound;
+  }
+
+  free(rz);
+  free(scfound);
+  free(schelp);
+}
+
+void make_c2_dim(int n)
+{
+  char small;
+  long i,j,k,x,y,i1,i2,j1,element,n1,maxi,count,hi;
+  double *hs,max,dx;
+  
+  check_alloc(hs=(double*)malloc(sizeof(double)*EMBED*DIM));
+  n1=scr[n];
+
+  count=0;
+  for (i1=0;i1<EMBED;i1++) {
+    i2=i1*DELAY;
+    for (j=0;j<DIM;j++)
+      hs[count++]=series[j][n1+i2];
+  }
+
+  x=(int)(hs[0]*epsinv)&imax;
+  y=(int)(hs[1]*epsinv)&imax;
+  
+  for (i1=x-1;i1<=x+1;i1++) {
+    i2=i1&imax;
+    for (j1=y-1;j1<=y+1;j1++) {
+      element=box[i2][j1&imax];
+      while (element != -1) {
+	if (labs((long)(element-n1)) > MINDIST) {
+	  count=0;
+	  max=0.0;
+	  maxi=howoften1;
+	  small=0;
+	  for (i=0;i<EMBED;i++) {
+	    hi=i*DELAY;
+	    for (j=0;j<DIM;j++) {
+	      dx=fabs(hs[count]-series[j][element+hi]);
+	      if (dx <= EPSMAX) {
+		if (dx > max) {
+		  max=dx;
+		  if (max < EPSMIN) {
+		    maxi=howoften1;
+		  }
+		  else {
+		    maxi=(lneps-log(max))/lnfac;
+		  }
+		}
+		if (count > 0)
+		  for (k=imin;k<=maxi;k++)
+		    found[count][k] += 1.0;
+	      }
+	      else {
+		small=1;
+		break;
+	      }
+	      count++;
+	    }
+	    if (small)
+	      break;
+	  }
+	}
+	element=list[element];
+      }
+    }
+  }
+
+  free(hs);
+}
+
+void make_c2_1(int n)
+{
+  int i,x,i1,maxi;
+  long element,n1;
+  double hs,max;
+  
+  n1=scr[n];
+  hs=series[0][n1];
+  
+  x=(int)(hs*epsinv)&imax;
+  
+  for (i1=x-1;i1<=x+1;i1++) {
+    element=boxc1[i1&imax];
+    while (element != -1) {
+      if (labs(element-n1) > MINDIST) {
+	max=fabs(hs-series[0][element]);
+	if (max <= EPSMAX) {
+	  if (max < EPSMIN)
+	    maxi=howoften1;
+	  else
+	    maxi=(lneps-log(max))/lnfac;
+	  for (i=imin;i<=maxi;i++)
+	    found[0][i] += 1.0;
+	}
+      }
+      element=listc1[element];
+    }
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char smaller,stdi=0;
+  FILE *fout,*fstat;
+  char *outd1,*outc1,*outh1,*outstat;
+  int maxembed;
+  long i1,j1,x,y,sn,n,i,j,n1,n2;
+  long *oscr;
+  long lnorm;
+  double eps,*epsm,EPSMAX1,maxinterval;
+  time_t mytime,lasttime;
+  
+  if (scan_help(argc,argv)) 
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (FOUT == NULL) {
+    if (!stdi) {
+      check_alloc(FOUT=calloc(strlen(infile)+1,(size_t)1));
+      strcpy(FOUT,infile);
+    }
+    else {
+      check_alloc(FOUT=calloc((size_t)6,(size_t)1));
+      strcpy(FOUT,"stdin");
+    }
+  }
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&DIM,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&DIM,column,
+				      dimset,verbosity);
+
+  if (rescale_set) {
+    for (i=0;i<DIM;i++)
+      rescale_data(series[i],length,&min,&interval);
+    maxinterval=1.0;
+  }
+  else {
+    maxinterval=0.0;
+    for (i=0;i<DIM;i++) {
+      min=interval=series[i][0];
+      for (j=1;j<length;j++) {
+	if (min > series[i][j])
+	  min=series[i][j];
+	if (interval < series[i][j])
+	  interval=series[i][j];
+      }
+      interval -= min;
+      if (interval > maxinterval)
+	maxinterval=interval;
+    }
+  }
+  if (!eps_max_set)
+    EPSMAX *= maxinterval;
+  if (!eps_min_set)
+    EPSMIN *= maxinterval;
+  EPSMAX=(fabs(EPSMAX)<maxinterval) ? fabs(EPSMAX) : maxinterval;
+  EPSMIN=(fabs(EPSMIN)<EPSMAX) ? fabs(EPSMIN) : EPSMAX/2.;
+  EPSMAX1=EPSMAX;
+
+  howoften1=HOWOFTEN-1;
+  maxembed=DIM*EMBED-1;
+
+  check_alloc(outd1=(char*)calloc(strlen(FOUT)+4,(size_t)1));
+  check_alloc(outc1=(char*)calloc(strlen(FOUT)+4,(size_t)1));
+  check_alloc(outh1=(char*)calloc(strlen(FOUT)+4,(size_t)1));
+  check_alloc(outstat=(char*)calloc(strlen(FOUT)+6,(size_t)1));
+  strcpy(outd1,FOUT);
+  strcpy(outc1,FOUT);
+  strcpy(outh1,FOUT);
+  strcpy(outstat,FOUT);
+  strcat(outd1,".d2");
+  strcat(outc1,".c2");
+  strcat(outh1,".h2");
+  strcat(outstat,".stat");
+  test_outfile(outd1);
+  test_outfile(outc1);
+  test_outfile(outh1);
+  test_outfile(outstat);
+
+  check_alloc(list=(long*)malloc(length*sizeof(long)));
+  check_alloc(listc1=(long*)malloc(length*sizeof(long)));
+  if ((long)(length-(EMBED-1)*DELAY) <= 0) {
+    fprintf(stderr,"Embedding dimension and delay are too large.\n"
+	    "The delay vector would be longer than the whole series."
+	    " Exiting\n");
+    exit(VECTOR_TOO_LARGE_FOR_LENGTH);
+  }
+  check_alloc(scr=(long*)malloc(sizeof(long)*(length-(EMBED-1)*DELAY)));
+  check_alloc(oscr=(long*)malloc(sizeof(long)*(length-(EMBED-1)*DELAY)));
+  check_alloc(found=(double**)malloc(DIM*EMBED*sizeof(double*)));
+  for (i=0;i<EMBED*DIM;i++)
+    check_alloc(found[i]=(double*)malloc(HOWOFTEN*sizeof(double)));
+  check_alloc(norm=(double*)malloc(HOWOFTEN*sizeof(double)));
+  check_alloc(epsm=(double*)malloc(HOWOFTEN*sizeof(double)));
+  
+  epsinv=1.0/EPSMAX;
+  epsfactor=pow(EPSMAX/EPSMIN,1.0/(double)howoften1);
+  lneps=log(EPSMAX);
+  lnfac=log(epsfactor);
+
+  epsm[0]=EPSMAX;
+  norm[0]=0.0;
+  for (i=1;i<HOWOFTEN;i++) {
+    norm[i]=0.0;
+    epsm[i]=epsm[i-1]/epsfactor;
+  }
+  imin=0;
+
+  scramble();
+  for (i=0;i<(length-(EMBED-1)*DELAY);i++)
+    oscr[scr[i]]=i;
+
+  for (i=0;i<DIM*EMBED;i++)
+    for (j=0;j<HOWOFTEN;j++)
+      found[i][j]=0.0;
+  
+  nmax=length-DELAY*(EMBED-1);
+
+  for (i1=0;i1<NMAX;i1++) {
+    boxc1[i1]= -1;
+    for (j1=0;j1<NMAX;j1++)
+      box[i1][j1]= -1;
+  }
+  time(&lasttime);
+  lnorm=0;
+  
+  for (n=1;n<nmax;n++) {
+    smaller=0;
+    sn=scr[n-1];
+    if (DIM > 1) {
+      x=(long)(series[0][sn]*epsinv)&imax;
+      y=(long)(series[1][sn]*epsinv)&imax;
+    }
+    else {
+      x=(long)(series[0][sn]*epsinv)&imax;
+      y=(long)(series[0][sn+DELAY]*epsinv)&imax;
+    }
+    list[sn]=box[x][y];
+    box[x][y]=sn;
+    listc1[sn]=boxc1[x];
+    boxc1[x]=sn;
+
+    i=imin;
+    while (found[maxembed][i] >= MAXFOUND) {
+      smaller=1;
+      if (++i > howoften1)
+	break;
+    }
+    if (smaller) {
+      imin=i;
+      if (imin <= howoften1) {
+	EPSMAX=epsm[imin];
+	epsinv=1.0/EPSMAX;
+	for (i1=0;i1<NMAX;i1++) {
+	  boxc1[i1]= -1;
+	  for (j1=0;j1<NMAX;j1++)
+	    box[i1][j1]= -1;
+	}
+	for (i1=0;i1<n;i1++) {
+	  sn=scr[i1];
+	  if (DIM > 1) {
+	    x=(long)(series[0][sn]*epsinv)&imax;
+	    y=(long)(series[1][sn]*epsinv)&imax;
+	  }
+	  else {
+	    x=(long)(series[0][sn]*epsinv)&imax;
+	    y=(long)(series[0][sn+DELAY]*epsinv)&imax;
+	  }
+	  list[sn]=box[x][y];
+	  box[x][y]=sn;
+	  listc1[sn]=boxc1[x];
+	  boxc1[x]=sn;
+	}
+      }
+    }
+
+    if (imin <= howoften1) {
+      lnorm=n;
+      if (MINDIST > 0) {
+	sn=scr[n];
+	n1=(sn-(long)MINDIST>=0)?sn-(long)MINDIST:0;
+	n2=(sn+MINDIST<length-(EMBED-1)*DELAY)?sn+MINDIST:
+	  length-(EMBED-1)*DELAY-1;
+	for (i1=n1;i1<=n2;i1++)
+	  if ((oscr[i1] < n))
+	    lnorm--;
+      }
+      
+      if (EMBED*DIM > 1)
+	make_c2_dim(n);
+      make_c2_1(n);
+      for (i=imin;i<HOWOFTEN;i++)
+	norm[i] += (double)(lnorm);
+    }
+    
+    if (((time(&mytime)-lasttime) > WHEN) || (n == (nmax-1)) || 
+	(imin > howoften1)) {
+      time(&lasttime);
+      fstat=fopen(outstat,"w");
+      if (verbosity&VER_USR1)
+	fprintf(stderr,"Opened %s for writing\n",outstat);
+      fprintf(fstat,"Center points treated so far= %ld\n",n);
+      fprintf(fstat,"Maximal epsilon in the moment= %e\n",epsm[imin]);
+      fclose(fstat);
+      fout=fopen(outc1,"w");
+      if (verbosity&VER_USR1)
+	fprintf(stderr,"Opened %s for writing\n",outc1);
+      fprintf(fout,"#center= %ld\n",n);
+      for (i=0;i<EMBED*DIM;i++) {
+	fprintf(fout,"#dim= %ld\n",i+1);
+	eps=EPSMAX1*epsfactor;
+	for (j=0;j<HOWOFTEN;j++) {
+	  eps /= epsfactor;
+	  if (norm[j] > 0.0)
+	    fprintf(fout,"%e %e\n",eps,found[i][j]/norm[j]);
+	}
+	fprintf(fout,"\n\n");
+      }
+      fclose(fout);
+      fout=fopen(outh1,"w");
+      if (verbosity&VER_USR1)
+	fprintf(stderr,"Opened %s for writing\n",outh1);
+      fprintf(fout,"#center= %ld\n",n);
+      fprintf(fout,"#dim= 1\n");
+      eps=EPSMAX1*epsfactor;
+      for (j=0;j<HOWOFTEN;j++) {
+	eps /= epsfactor;
+	if (found[0][j] > 0.0)
+	  fprintf(fout,"%e %e\n",eps,-log(found[0][j]/norm[j]));
+      }
+      fprintf(fout,"\n\n");
+      for (i=1;i<DIM*EMBED;i++) {
+	fprintf(fout,"#dim= %ld\n",i+1);
+	eps=EPSMAX1*epsfactor;
+	for (j=0;j<HOWOFTEN;j++) {
+	  eps /= epsfactor;
+	  if ((found[i-1][j] > 0.0) && (found[i][j] > 0.0))
+	    fprintf(fout,"%e %e\n",eps,log(found[i-1][j]/found[i][j]));
+	}
+	fprintf(fout,"\n\n");
+      }
+      fclose(fout);
+      fout=fopen(outd1,"w");
+      if (verbosity&VER_USR1)
+	fprintf(stderr,"Opened %s for writing\n",outd1);
+      fprintf(fout,"#center= %ld\n",n);
+      for (i=0;i<DIM*EMBED;i++) {
+	fprintf(fout,"#dim= %ld\n",i+1);
+	eps=EPSMAX1;
+	for (j=1;j<HOWOFTEN;j++) {
+	  eps /= epsfactor;
+	  if ((found[i][j] > 0.0) && (found[i][j-1] > 0.0))
+	    fprintf(fout,"%e %e\n",eps,log(found[i][j-1]/found[i][j]
+					   /norm[j-1]*norm[j])/lnfac);
+	}
+	fprintf(fout,"\n\n");
+      }
+      fclose(fout);
+      if (imin > howoften1)
+	exit(0);
+    }
+  }
+
+  if (infile != NULL)
+    free(infile);
+  free(outd1);
+  free(outh1);
+  free(outc1);
+  free(outstat);
+  free(list);
+  free(listc1);
+  free(scr);
+  free(oscr);
+  free(norm);
+  free(epsm);
+  for (i=0;i<EMBED*DIM;i++)
+    free(found[i]);
+  free(found);
+  for (i=0;i<DIM;i++)
+    free(series[i]);
+  free(series);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/delay.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/delay.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,331 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified (rewritten in C) Aug 22, 2004*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <ctype.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Produces delay vectors"
+
+
+unsigned long length=ULONG_MAX;
+unsigned long exclude=0;
+unsigned int verbosity=0xff;
+int delay=1;
+unsigned int indim=1,embdim=2;
+char *column=NULL,*format=NULL,*multidelay=NULL;
+char *outfile=NULL;
+char *infile=NULL;
+char dimset=0,formatset=0,embset=0,mdelayset=0,delayset=0;
+char stdo=1;
+
+double **series;
+unsigned int *formatlist,*delaylist;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"\nUsage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted as a"
+	  " possible datafile.\nIf no datafile is given stdin is read."
+	  " Just - also means stdin\n");
+  fprintf(stderr,"\t-l # of data [default: whole file]\n");
+  fprintf(stderr,"\t-x # of rows to ignore [default: 0]\n");
+  fprintf(stderr,"\t-M num. of columns to read [default: %u]\n",indim);
+  fprintf(stderr,"\t-c columns to read [default: 1,...,M]\n");
+  fprintf(stderr,"\t-m dimension [default: 2]\n");
+  fprintf(stderr,"\t-F format of the delay vector (see man page)\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-D multi delay list (see man page)\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-o output file [default: 'datafile'.del, "
+	  "without -o: stdout]\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **str)
+{
+  char *out;
+
+  if ((out=check_option(str,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(str,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(str,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(str,n,'M','u')) != NULL) {
+    sscanf(out,"%u",&indim);
+    dimset=1;
+  }
+  if ((out=check_option(str,n,'F','s')) != NULL) {
+    format=out;
+    formatset=1;
+  }
+  if ((out=check_option(str,n,'m','u')) != NULL) {
+    sscanf(out,"%u",&embdim);
+    embset=1;
+  }
+  if ((out=check_option(str,n,'d','u')) != NULL) {
+    sscanf(out,"%u",&delay);
+    delayset=1;
+  }
+  if ((out=check_option(str,n,'D','s')) != NULL) {
+    multidelay=out;
+    mdelayset=1;
+  }
+  if ((out=check_option(str,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(str,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void create_format_list(void)
+{
+  unsigned int i=0,num=0,sum=0;
+
+  while (format[i]) {
+    if (!(isdigit(format[i])) && !(format[i] == ',')) {
+      fprintf(stderr,"Wrong format of -F parameter. Exiting!\n");
+      exit(DELAY_WRONG_FORMAT_F);
+    }
+    i++;
+  }
+
+  i=0;
+  while (format[i]) {
+    if (format[i++] == ',')
+      num++;
+  }
+
+  check_alloc(formatlist=(unsigned int*)malloc(sizeof(int)*(num+1)));
+  for (i=0;i<=num;i++) {
+    sscanf(format,"%d",&formatlist[i]);
+    if (i<num) {
+      while ((*format) != ',')
+	format++;
+    }
+    format++;
+  }
+
+  if (dimset && ((num+1) != indim)) {
+    fprintf(stderr,"Number of dimensions in -F is not equal to -M. Exiting!\n");
+    exit(DELAY_DIM_NOT_EQUAL_F_M);
+  }
+
+  for (i=0;i<=num;i++)
+    sum += formatlist[i];
+  if (embset && (sum != embdim)) {
+    fprintf(stderr,"The dimensions given in -m and -F are not equal!"
+	    " Exiting\n");
+    exit(DELAY_DIM_NOT_EQUAL_F_m);
+  }
+  if (!dimset)
+    indim=num+1;
+  if (!embset)
+    embdim=sum;
+}
+
+void create_delay_list(void)
+{
+  unsigned int i=0,num=0;
+
+  while (multidelay[i]) {
+    if (!(isdigit(multidelay[i])) && !(multidelay[i] == ',')) {
+      fprintf(stderr,"Wrong format of -D parameter. Exiting!\n");
+      exit(DELAY_WRONG_FORMAT_D);
+    }
+    i++;
+  }
+
+  i=0;
+  while (multidelay[i]) {
+    if (multidelay[i++] == ',')
+      num++;
+  }
+
+  check_alloc(delaylist=(unsigned int*)malloc(sizeof(int)*(num+1)));
+  for (i=0;i<=num;i++) {
+    sscanf(multidelay,"%d",&delaylist[i]);
+    if (i<num) {
+      while ((*multidelay) != ',')
+	multidelay++;
+    }
+    multidelay++;
+  }
+
+  if ((num+1) != (embdim-indim)) {
+    fprintf(stderr,"Wrong number of delays. See man page. Exiting!\n");
+    exit(DELAY_WRONG_NUM_D);
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stin=0;
+  unsigned long i;
+  int j,k;
+  unsigned int alldim,maxemb,emb,rundel,delsum,runmdel;
+  unsigned int *inddelay;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stin=1;
+
+  if (outfile == NULL) {
+    if (!stin) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,1));
+      strcpy(outfile,infile);
+      strcat(outfile,".del");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc(10,1));
+      strcpy(outfile,"stdin.del");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (delayset && mdelayset) {
+    fprintf(stderr,"-d and -D can't be used simultaneously. Exiting!\n");
+    exit(DELAY_INCONS_d_D);
+  }
+
+  if (delay < 1) {
+    fprintf(stderr,"Delay has to be larger than 0. Exiting!\n");
+    exit(DELAY_SMALL_ZERO);
+  }
+
+  if (!formatset && (embdim%indim)) {
+    fprintf(stderr,"Inconsistent -m and -M. Please set -F\n");
+    exit(DELAY_INCONS_m_M);
+  }
+  if (formatset) {
+    create_format_list();
+  }
+  else {
+    check_alloc(formatlist=(unsigned int*)malloc(sizeof(int)*indim));
+    for (i=0;i<indim;i++) {
+      formatlist[i]=embdim/indim;
+    }
+  }
+
+  alldim=0;
+  for (i=0;i<indim;i++)
+    alldim += formatlist[i];
+
+  if (mdelayset) {
+    create_delay_list();
+  }
+
+  check_alloc(inddelay=(unsigned int*)malloc(sizeof(int)*alldim));
+
+  rundel=0;
+  if (!mdelayset) {
+    for (i=0;i<indim;i++) {
+      delsum=0;
+      inddelay[rundel++]=delsum;
+      for (j=1;j<formatlist[i];j++) {
+	delsum += delay;
+	inddelay[rundel++]=delsum;
+      }
+    }
+  }
+  else {
+    runmdel=0;
+    for (i=0;i<indim;i++) {
+      delsum=0;
+      inddelay[rundel++]=delsum;
+      for (j=1;j<formatlist[i];j++) {
+	delsum += delaylist[runmdel++];
+	inddelay[rundel++]=delsum;
+      }
+    }
+  }
+
+  maxemb=0;
+  for (i=0;i<alldim;i++)
+    maxemb=(maxemb<inddelay[i])?inddelay[i]:maxemb;
+
+  if (column == NULL) {
+    series=get_multi_series(infile,&length,exclude,&indim,"",dimset,verbosity);
+  }
+  else {
+    series=get_multi_series(infile,&length,exclude,&indim,column,dimset,
+			    verbosity);
+  }
+
+  if (stdo) {
+    if (verbosity)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=maxemb;i<length;i++) {
+      rundel=0;
+      for (j=0;j<indim;j++) {
+	emb=formatlist[j];
+	for (k=0;k<emb;k++)
+	  fprintf(stdout,"%e ",series[j][i-inddelay[rundel++]]);
+      }
+      fprintf(stdout,"\n");
+    }
+  }
+  else {
+    fout=fopen(outfile,"w");
+    if (verbosity)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=maxemb;i<length;i++) {
+      for (j=0;j<indim;j++) {
+	rundel=0;
+	emb=formatlist[j];
+	for (k=0;k<emb;k++)
+	  fprintf(fout,"%e ",series[j][i-inddelay[rundel++]]);
+      }
+      fprintf(fout,"\n");
+    }
+    fclose(fout);
+  }
+
+  if (formatlist != NULL)
+    free(formatlist);
+  if (delaylist != NULL)
+    free(delaylist);
+  free(inddelay);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/extrema.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/extrema.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,225 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Dec 17, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Determines the maxima (minima) of a possibly multivariate\
+ time series"
+
+
+unsigned long length=ULONG_MAX,exclude=0;
+char *column=NULL;
+unsigned int verbosity=0xff;
+unsigned int dim=1;
+unsigned int which=1;
+double mintime=0.0;
+char dimset=0;
+char maxima=1;
+char stdo=1;
+char *outfile=NULL;
+char *infile=NULL;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of points to use [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default: 0]\n");
+  fprintf(stderr,"\t-m dimension (# of components) [Default: 1]\n");
+  fprintf(stderr,"\t-c columns to read [Default: 1,...,# of components]\n");
+  fprintf(stderr,"\t-w which component to maxi(mini)mize [Default: 1]\n");
+  fprintf(stderr,"\t-z determine minima instead of maxima [Default: maxima]\n");
+  fprintf(stderr,"\t-t minimal required time between two extrema "
+	  "[Default: 0.0]\n");
+  fprintf(stderr,"\t-o output file name [Default: 'datafile'.ext,"
+	  " without -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'w','u')) != NULL)
+    sscanf(out,"%u",&which);
+  if ((out=check_option(in,n,'z','n')) != NULL)
+    maxima=0;
+  if ((out=check_option(in,n,'t','f')) != NULL)
+    sscanf(out,"%lf",&mintime);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  unsigned long i,j;
+  double **series;
+  double x[3],a,b,c,lasttime,nexttime,time;
+  FILE *fout=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  which--;
+  if (which > (dim-1)) {
+    fprintf(stderr,"The component to maxi(mini)mize has to be smaller or equal"
+	    "to the number\nof components! Exiting\n");
+    exit(EXTREMA_STRANGE_COMPONENT);
+  }
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.ext",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.ext");
+    }
+  }
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,column,
+				      dimset,verbosity);
+  
+  if (!stdo) {
+    test_outfile(outfile);    
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+  
+  lasttime=0.0;
+  x[0]=series[which][0];
+  x[1]=series[which][1];
+  for (i=2;i<length;i++) {
+    x[2]=series[which][i];
+    if (maxima) {
+      if ((x[1] >= x[0]) && (x[1] > x[2])) {
+	a=x[1];
+	b=(x[2]-x[0])/2.0;
+	c=(x[2]-2.0*x[1]+x[0])/2.0;
+	time= -b/2.0/c;
+	nexttime=(double)i-1.0+time;
+	if ((nexttime-lasttime) >= mintime) {
+	  for (j=0;j<dim;j++) {
+	    a=series[j][i-1];
+	    b=(series[j][i]-series[j][i-2])/2.0;
+	    c=(series[j][i]-2.0*series[j][i-1]+series[j][i-2])/2.0;
+	    if (!stdo)
+	      fprintf(fout,"%e ",a+b*time+c*sqr(time));
+	    else
+	      fprintf(stdout,"%e ",a+b*time+c*sqr(time));
+	  }
+	  if (!stdo)
+	    fprintf(fout,"%e\n",nexttime-lasttime);
+	  else
+	    fprintf(stdout,"%e\n",nexttime-lasttime);
+	  lasttime=nexttime;
+	}
+      }
+    }
+    else {
+      if ((x[1] <= x[0]) && (x[1] < x[2])) {
+	a=x[1];
+	b=(x[2]-x[0])/2.0;
+	c=(x[2]-2.0*x[1]+x[0])/2.0;
+	time= -b/2.0/c;
+	nexttime=(double)i-1.0+time;
+	if ((nexttime-lasttime) >= mintime) {
+	  for (j=0;j<dim;j++) {
+	    a=series[j][i-1];
+	    b=(series[j][i]-series[j][i-2])/2.0;
+	    c=(series[j][i]-2.0*series[j][i-1]+series[j][i-2])/2.0;
+	    if (!stdo)
+	      fprintf(fout,"%e ",a+b*time+c*sqr(time));
+	    else
+	      fprintf(stdout,"%e ",a+b*time+c*sqr(time));
+	  }
+	  if (!stdo)
+	    fprintf(fout,"%e\n",nexttime-lasttime);
+	  else
+	    fprintf(stdout,"%e\n",nexttime-lasttime);
+	  lasttime=nexttime;
+	}
+      }
+    }
+    x[0]=x[1];
+    x[1]=x[2];
+  }
+  if (!stdo)
+    fclose(fout);
+
+  if (infile != NULL)
+    free(infile);
+  if (outfile != NULL)
+    free(outfile);
+  for (i=0;i<dim;i++)
+    free(series[i]);
+  free(series);
+  
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/false_nearest.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/false_nearest.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,328 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Dec 10, 2005 */
+/*Changes:
+  12/10/05: It's multivariate now
+  12/16/05: Scaled <eps> and sigma(eps)
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Determines the fraction of false nearest neighbors."
+
+char *outfile=NULL;
+char *infile=NULL;
+char stdo=1,dimset=0;
+char *column=NULL;
+unsigned long length=ULONG_MAX,exclude=0,theiler=0;
+unsigned int delay=1,maxdim=5,minemb=1;
+unsigned int comp=1,maxemb=5;
+unsigned int verbosity=0xff;
+double rt=2.0;
+double eps0=1.0e-5;
+double **series;
+double aveps,vareps;
+double varianz;
+
+#define BOX 1024
+int ibox=BOX-1;
+long **box,*list;
+unsigned int *vcomp,*vemb;
+unsigned long toolarge;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1]\n");
+  fprintf(stderr,"\t-m min. test embedding dimension [default: %u]\n",minemb);
+  fprintf(stderr,"\t-M # of components,max. emb. dim. [default: %u,%u]\n",
+	  comp,maxemb);
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-f escape factor [default: %.2lf]\n",rt);
+  fprintf(stderr,"\t-t theiler window [default: 0]\n");
+  fprintf(stderr,"\t-o output file [default: 'datafile'.fnn; without -o"
+	  " stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 3]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+          "2='+ information about the current state\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&minemb);
+  if ((out=check_option(in,n,'M','2')) != NULL) {
+    sscanf(out,"%u,%u",&comp,&maxemb);
+    maxdim=comp*(maxemb+1);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&rt);
+  if ((out=check_option(in,n,'t','u')) != NULL)
+    sscanf(out,"%lu",&theiler);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void mmb(unsigned int hdim,unsigned int hemb,double eps)
+{
+  unsigned long i;
+  long x,y;
+
+  for (x=0;x<BOX;x++)
+    for (y=0;y<BOX;y++)
+      box[x][y] = -1;
+
+  for (i=0;i<length-(maxemb+1)*delay;i++) {
+    x=(long)(series[0][i]/eps)&ibox;
+    y=(long)(series[hdim][i+hemb]/eps)&ibox;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
+char find_nearest(long n,unsigned int dim,double eps)
+{
+  long x,y,x1,x2,y1,i,i1,ic,ie;
+  long element,which= -1;
+  double dx,maxdx,mindx=1.1,hfactor,factor;
+
+  ic=vcomp[dim];
+  ie=vemb[dim];
+  x=(long)(series[0][n]/eps)&ibox;
+  y=(long)(series[ic][n+ie]/eps)&ibox;
+  
+  for (x1=x-1;x1<=x+1;x1++) {
+    x2=x1&ibox;
+    for (y1=y-1;y1<=y+1;y1++) {
+      element=box[x2][y1&ibox];
+      while (element != -1) {
+	if (labs(element-n) > theiler) {
+	  maxdx=fabs(series[0][n]-series[0][element]);
+	  for (i=1;i<=dim;i++) {
+	    ic=vcomp[i];
+	    i1=vemb[i];
+	    dx=fabs(series[ic][n+i1]-series[ic][element+i1]);
+	    if (dx > maxdx)
+	      maxdx=dx;
+	  }
+	  if ((maxdx < mindx) && (maxdx > 0.0)) {
+	    which=element;
+	    mindx=maxdx;
+	  }
+	}
+	element=list[element];
+      }
+    }
+  }
+
+  if ((which != -1) && (mindx <= eps) && (mindx <= varianz/rt)) {
+    aveps += mindx;
+    vareps += mindx*mindx;
+    factor=0.0;
+    for (i=1;i<=comp;i++) {
+      ic=vcomp[dim+i];
+      ie=vemb[dim+i];
+      hfactor=fabs(series[ic][n+ie]-series[ic][which+ie])/mindx;
+      if (hfactor > factor) 
+	factor=hfactor;
+    }
+    if (factor > rt)
+      toolarge++;
+    return 1;
+  }
+  return 0;
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  FILE *file=NULL;
+  double min,inter=0.0,ind_inter,epsilon,av,ind_var;
+  char *nearest,alldone;
+  long i;
+  unsigned int dim,emb;
+  unsigned long donesofar;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".fnn");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.fnn");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,column,
+				      dimset,verbosity);
+
+  for (i=0;i<comp;i++) {
+    rescale_data(series[i],length,&min,&ind_inter);
+    variance(series[i],length,&av,&ind_var);
+    if (i == 0) {
+      varianz=ind_var;
+      inter=ind_inter;
+    }
+    else {
+      varianz=(varianz>ind_var)?ind_var:varianz;
+      inter=(inter<ind_inter)?ind_inter:inter;
+    }
+  }
+
+  check_alloc(list=(long*)malloc(sizeof(long)*length));
+  check_alloc(nearest=(char*)malloc(length));
+  check_alloc(box=(long**)malloc(sizeof(long*)*BOX));
+  for (i=0;i<BOX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*BOX));
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+  check_alloc(vcomp=(unsigned int*)malloc(sizeof(int)*(maxdim)));
+  check_alloc(vemb=(unsigned int*)malloc(sizeof(int)*(maxdim)));
+  for (i=0;i<maxdim;i++) {
+    if (comp == 1) {
+      vcomp[i]=0;
+      vemb[i]=i;
+    }
+    else {
+      vcomp[i]=i%comp;
+      vemb[i]=(i/comp)*delay;
+    }
+  }
+  for (emb=minemb;emb<=maxemb;emb++) {
+    dim=emb*comp-1;
+    epsilon=eps0;
+    toolarge=0;
+    alldone=0;
+    donesofar=0;
+    aveps=0.0;
+    vareps=0.0;
+    for (i=0;i<length;i++)
+      nearest[i]=0;
+    if (verbosity&VER_USR1)
+      fprintf(stderr,"Start for dimension=%u\n",dim+1);
+    while (!alldone && (epsilon < 2.*varianz/rt)) {
+      alldone=1;
+      mmb(vcomp[dim],vemb[dim],epsilon);
+      for (i=0;i<length-maxemb*delay;i++)
+	if (!nearest[i]) {
+	  nearest[i]=find_nearest(i,dim,epsilon);
+	  alldone &= nearest[i];
+	  donesofar += (unsigned long)nearest[i];
+	}
+      if (verbosity&VER_USR1)
+	fprintf(stderr,"Found %lu up to epsilon=%e\n",donesofar,epsilon*inter);
+      epsilon*=sqrt(2.0);
+      if (!donesofar)
+	eps0=epsilon;
+    }
+    if (donesofar == 0) {
+      fprintf(stderr,"Not enough points found!\n");
+      exit(FALSE_NEAREST_NOT_ENOUGH_POINTS);
+    }
+    aveps *= (1./(double)donesofar);
+    vareps *= (1./(double)donesofar);
+    if (stdo) {
+      fprintf(stdout,"%u %e %e %e\n",dim+1,(double)toolarge/(double)donesofar,
+	      aveps*inter,sqrt(vareps)*inter);
+      fflush(stdout);
+    }
+    else {
+      fprintf(file,"%u %e %e %e\n",dim+1,(double)toolarge/(double)donesofar,
+	      aveps*inter,sqrt(vareps)*inter);
+      fflush(file);
+    }
+  }
+  if (!stdo)
+    fclose(file);
+
+  if (infile != NULL)
+    free(infile);
+  if (outfile != NULL)
+    free(outfile);
+  free(series);
+  free(list);
+  free(nearest);
+  for (i=0;i<BOX;i++)
+    free(box[i]);
+  free(box);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/fsle.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/fsle.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,304 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, last modified: Mar 20, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the finite size Lyapunov exponent; Vulpiani et al."
+
+
+#define NMAX 256
+
+char *outfile=NULL;
+char *infile=NULL;
+char epsset=0,stdo=1;
+double *series;
+long box[NMAX][NMAX],*list;
+unsigned int dim=2,delay=1,mindist=0;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+const unsigned int nmax=NMAX-1;
+unsigned long length=ULONG_MAX,exclude=0;
+double eps0=1.e-3,eps,epsinv,epsmax,epsfactor;
+int howmany;
+
+struct fsle {
+  double time,factor,eps;
+  long count;
+} *data;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of datapoints [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-c column to read[default 1]\n");
+  fprintf(stderr,"\t-m embedding dimension [default 2]\n");
+  fprintf(stderr,"\t-d delay  [default 1]\n");
+  fprintf(stderr,"\t-t time window to omit [default 0]\n");
+  fprintf(stderr,"\t-r epsilon size to start with [default "
+	  "(std. dev. of data)/1000]\n");
+  fprintf(stderr,"\t-o name of output file [default 'datafile'.fsl ,"
+	  "without -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(argv,n,'m','u')) != NULL)
+    sscanf(out,"%u",&dim);
+  if ((out=check_option(argv,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(argv,n,'t','u')) != NULL)
+    sscanf(out,"%u",&mindist);
+  if ((out=check_option(argv,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&eps0);
+  }
+  if ((out=check_option(argv,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+      
+void put_in_boxes(void)
+{
+  int i,j,x,y,del;
+
+  for (i=0;i<NMAX;i++)
+    for (j=0;j<NMAX;j++)
+      box[i][j]= -1;
+
+  del=delay*(dim-1);
+  for (i=0;i<length-del;i++) {
+    x=(int)(series[i]*epsinv)&nmax;
+    y=(int)(series[i+del]*epsinv)&nmax;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
+char make_iterate(long act)
+{
+  char ok=0;
+  int x,y,i,j,i1,k,del1=dim*delay,which;
+  long element,minelement= -1;
+  double dx=0.0,mindx=2.0,stime;
+
+  x=(int)(series[act]*epsinv)&nmax;
+  y=(int)(series[act+delay*(dim-1)]*epsinv)&nmax;
+  for (i=x-1;i<=x+1;i++) {
+    i1=i&nmax;
+    for (j=y-1;j<=y+1;j++) {
+      element=box[i1][j&nmax];
+      while (element != -1) {
+	if (labs(act-element) > mindist) {
+	  for (k=0;k<del1;k+=delay) {
+	    dx = fabs(series[act+k]-series[element+k]);
+	    if (dx > eps)
+	      break;
+	  }
+	  if (k==del1) {
+	    if (dx < mindx) {
+	      ok=1;
+	      if (dx > 0.0) {
+		mindx=dx;
+		minelement=element;
+	      }
+	    }
+	  }
+	}
+	element=list[element];
+      }
+    }
+  }
+  
+  if ((minelement != -1) && (mindx < eps)) {
+    act += del1-delay+1;
+    minelement += del1-delay+1;
+    which=(int)(log(mindx/eps0)/log(epsfactor));
+    if (which < 0) {
+      while ((dx=fabs(series[act]-series[minelement])) < data[0].eps) {
+	act++;
+	minelement++;
+	if ((act >= length) || (minelement >= length))
+	  return ok;
+      }
+      mindx=dx;
+      which=(int)(log(mindx/eps0)/log(epsfactor));
+    }
+    for (i=which;i<howmany-1;i++) {
+      stime=0;
+      while ((dx=fabs(series[act]-series[minelement])) < data[i+1].eps) {
+	act++;
+	minelement++;
+	if ((act >= length) || (minelement >= length))
+	  return ok;
+	stime++;
+      }
+      if (stime > 0) {
+	data[i].time += stime;
+	data[i].factor += log(dx/mindx);
+	data[i].count++;
+      }
+      mindx=dx;
+    }
+  }
+  return ok;
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0,*done,alldone;
+  int i;
+  long n;
+  long maxlength;
+  double min,max,se_av,se_var,se0_av,se0_var;
+  FILE *file;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".fsl");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.fsl");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  variance(series,length,&se0_av,&se0_var);
+  rescale_data(series,length,&min,&max);
+  variance(series,length,&se_av,&se_var);
+  
+  if (epsset) {
+    eps0 /= max;
+    epsmax=se0_var;
+  }
+  else {
+    eps0 *= se_var;
+    epsmax=se_var;
+  }
+  if (eps0 >= epsmax) {
+    fprintf(stderr,"The minimal epsilon is too large. Exiting!\n");
+    exit(FSLE__TOO_LARGE_MINEPS);
+  }
+  epsfactor=sqrt(2.0);
+
+  howmany=(int)(log(epsmax/eps0)/log(epsfactor))+1;
+  check_alloc(data=(struct fsle*)malloc(sizeof(struct fsle)*howmany));
+  eps=eps0/epsfactor;
+  for (i=0;i<howmany;i++) {
+    data[i].time=data[i].factor=0.0;
+    data[i].eps= (eps *= epsfactor);
+    data[i].count=0;
+  }
+  
+  check_alloc(list=(long*)malloc(length*sizeof(long)));
+  check_alloc(done=(char*)malloc(length));
+
+  for (i=0;i<length;i++)
+    done[i]=0;
+  
+  maxlength=length-delay*(dim-1)-1-mindist;
+  alldone=0;
+  for (eps=eps0;(eps<=epsmax) && (!alldone);eps*=epsfactor) {
+    epsinv=1.0/eps;
+    put_in_boxes();
+    alldone=1;
+    for (n=0;n<=maxlength;n++) {
+      if (!done[n])
+	done[n]=make_iterate(n);
+      alldone &= done[n];
+    }
+  } 
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=0;i<howmany;i++)
+      if (data[i].factor > 0.0)
+	fprintf(file,"%e %e %ld\n",data[i].eps*max,
+		data[i].factor/data[i].time,data[i].count);
+    fclose(file);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=0;i<howmany;i++)
+      if (data[i].factor > 0.0)
+	fprintf(stdout,"%e %e %ld\n",data[i].eps*max,
+		data[i].factor/data[i].time,data[i].count);
+  }    
+
+  if (infile != NULL)
+    free(infile);
+  if (outfile != NULL)
+    free(outfile);
+  free(series);
+  free(data);
+  free(list);
+  free(done);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/ghkss.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/ghkss.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,503 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Jun 10, 2006 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Multivariate noise reduction using the GHKSS algorithm"
+
+
+#define BOX (unsigned int)1024
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int dim,qdim=2,delay=1,minn=50,iterations=1,comp=1,embed=5;
+unsigned int verbosity=0xff;
+double mineps,epsfac;
+char *column=NULL;
+char eps_set=0,euclidean=0,dimset=0,resize_eps;
+char *outfile=NULL,stdo=1;
+char *infile=NULL;
+
+double *d_min,*d_max,d_max_max;
+double **series,**delta,**corr;
+double *metric,trace;
+long **box,*list;
+unsigned long *flist;
+int emb_offset;
+unsigned int ibox=BOX-1;
+unsigned int *index_comp,*index_embed;
+
+/*these are global to save time*/
+int *sorted;
+double *av,**mat,*matarray,*eig;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default: 0]\n");
+  fprintf(stderr,"\t-c column to read [Default: 1,..,# of components]\n");
+  fprintf(stderr,"\t-m # of components,embedding dimension [Default: 1,5]\n");
+  fprintf(stderr,"\t-d delay [Default: 1]\n");
+  fprintf(stderr,"\t-q dimension to project to [Default: 2]\n");
+  fprintf(stderr,"\t-k minimal number of neighbours [Default: 50]\n");
+  fprintf(stderr,"\t-r minimal neighbourhood size \n\t\t"
+	  "[Default: (interval of data)/1000]\n");
+  fprintf(stderr,"\t-i # of iterations [Default: 1]\n");
+  fprintf(stderr,"\t-2 use euklidean metric [Default: non euklidean]\n");
+  fprintf(stderr,"\t-o name of output file \n\t\t"
+	  "[Default: 'datafile'.opt.n, where n is the iteration.\n\t\t"
+	  " If no -o is given, the last iteration is also"
+	  " written to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 7]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+          "2='+ average correction and trend'\n\t\t"
+	  "4='+ how many points for which epsilon'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&comp,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'q','u')) != NULL)
+    sscanf(out,"%u",&qdim);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&minn);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    eps_set=1;
+    sscanf(out,"%lf",&mineps);
+  }
+  if ((out=check_option(in,n,'i','u')) != NULL)
+    sscanf(out,"%u",&iterations);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'2','n')) != NULL)
+    euclidean=1;
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void sort(double *x,int *n)
+{
+  long i,j,iswap;
+  double dswap;
+  
+  for (i=0;i<dim;i++)
+    n[i]=i;
+  
+  for (i=0;i<dim-1;i++)
+    for (j=i+1;j<dim;j++)
+      if (x[j] > x[i]) {
+	dswap=x[i];
+	x[i]=x[j];
+	x[j]=dswap;
+	iswap=n[i];
+	n[i]=n[j];
+	n[j]=iswap;
+      }
+}
+
+void mmb(double eps)
+{
+  long i,x,y;
+  double ieps=1.0/eps;
+
+  for (x=0;x<BOX;x++)
+    for (y=0;y<BOX;y++)
+      box[x][y] = -1;
+  
+  for (i=emb_offset;i<length;i++) {
+    x=(int)(series[0][i]*ieps)&ibox;
+    y=(int)(series[comp-1][i-emb_offset]*ieps)&ibox;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
+unsigned long fmn(long which,double eps)
+{
+  unsigned long nf=0;
+  long i,i1,i2,j,j1,k,k1,li;
+  long element;
+  double dx=0.0;
+  
+  i=(int)(series[0][which]/eps)&ibox;
+  j=(int)(series[comp-1][which-emb_offset]/eps)&ibox;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&ibox;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&ibox];
+      while (element != -1) {
+	for (k=0;k<embed;k++) {
+	  k1= -k*(int)delay;
+	  for (li=0;li<comp;li++) {
+	    dx=fabs(series[li][which+k1]-series[li][element+k1]);
+	    if (dx > eps)
+	      break;
+	  }
+	  if (dx > eps)
+	    break;
+	}
+	if (dx <= eps)
+	  flist[nf++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nf;
+}
+
+void make_correction(unsigned long n,unsigned long nf)
+{
+  long i,i1,i2,j,j1,j2,k,k1,k2,hs;
+  double help;
+  
+  for (i=0;i<dim;i++) {
+    i1=index_comp[i];
+    i2=index_embed[i];
+    help=0.0;
+    for (j=0;j<nf;j++)
+      help += series[i1][flist[j]-i2];
+    av[i]=help/nf;
+  }
+
+  for (i=0;i<dim;i++) {
+    i1=index_comp[i];
+    i2=index_embed[i];
+    for (j=i;j<dim;j++) {
+      help=0.0;
+      j1=index_comp[j];
+      j2=index_embed[j];
+      for (k=0;k<nf;k++) {
+	hs=flist[k];
+	help += series[i1][hs-i2]*series[j1][hs-j2];
+      }
+      mat[i][j]=(help/nf-av[i]*av[j])*metric[i]*metric[j];
+      mat[j][i]=mat[i][j];
+    }
+  }
+
+  eigen(mat,(unsigned long)dim,eig);
+  sort(eig,sorted);
+
+  for (i=0;i<dim;i++) {
+    help=0.0;
+    for (j=qdim;j<dim;j++) {
+      hs=sorted[j];
+      for (k=0;k<dim;k++) {
+	k1=index_comp[k];
+	k2=index_embed[k];
+	help += (series[k1][n-k2]-av[k])*mat[k][hs]*mat[i][hs]*metric[k];
+      }
+    }
+    corr[n][i]=help/metric[i];
+  }
+}
+
+void handle_trend(unsigned long n,unsigned long nf)
+{
+  long i,i1,i2,j;
+  double help;
+  
+  for (i=0;i<dim;i++) {
+    help=0.0;
+    for (j=0;j<nf;j++)
+      help += corr[flist[j]][i];
+    av[i]=help/nf;
+  }
+
+  for (i=0;i<dim;i++) {
+    i1=index_comp[i];
+    i2=index_embed[i];
+    delta[i1][n-i2] += (corr[n][i]-av[i])/(trace*metric[i]);
+  }
+}
+
+void set_correction(void)
+{
+  long i,j;
+  double *hav,*hsigma,help;
+
+  check_alloc(hav=(double*)malloc(sizeof(double)*comp));
+  check_alloc(hsigma=(double*)malloc(sizeof(double)*comp));
+  for (j=0;j<comp;j++)
+    hav[j]=hsigma[j]=0.0;
+
+  for (i=0;i<length;i++)
+    for (j=0;j<comp;j++) {
+      hav[j] += (help=delta[j][i]);
+      hsigma[j] += help*help;
+    }
+
+  for (j=0;j<comp;j++) {
+    hav[j] /= length;
+    hsigma[j]=sqrt(fabs(hsigma[j]/length-hav[j]*hav[j]));
+  }
+  if (verbosity&(VER_USR1|VER_USR2)) {
+    for (i=0;i<comp;i++) {
+      fprintf(stderr,"Average shift of component %ld = %e\n",i+1,
+	      hav[i]*d_max[i]);
+      fprintf(stderr,"Average rms correction of comp. %ld = %e\n\n",
+	      i+1,hsigma[i]*d_max[i]);
+    }
+  }
+  for (i=0;i<length;i++)
+    for (j=0;j<comp;j++)
+      series[j][i] -= delta[j][i];
+
+  if (resize_eps) {
+    mineps /= epsfac;
+    if (verbosity&VER_USR2)
+      fprintf(stderr,"Reset minimal neighbourhood size to %e\n",
+	      mineps*d_max_max);
+  }
+
+  resize_eps=0;
+  free(hav);
+  free(hsigma);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  int iter,epscount,*ok;
+  long i,j;
+  char all_done;
+  char *ofname;
+  unsigned long nfound,n,allfound;
+  double epsilon;
+  double **hser;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  dim=comp*embed;
+  emb_offset=(embed-1)*delay;
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      check_alloc(ofname=(char*)calloc(strlen(infile)+9,(size_t)1));
+      sprintf(outfile,"%s.opt",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      check_alloc(ofname=(char*)calloc((size_t)14,(size_t)1));
+      sprintf(outfile,"stdin.opt");
+    }
+  }
+  else
+    check_alloc(ofname=(char*)calloc(strlen(outfile)+10,(size_t)1));
+  
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,"",
+				     dimset,verbosity);
+  else 
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,column,
+				      dimset,verbosity);
+
+  if (length < minn) {
+    fprintf(stderr,"With %lu data you will never find %u neighbors."
+	    " Exiting!\n",length,minn);
+    exit(GHKSS__TOO_MANY_NEIGHBORS);
+  }
+
+  check_alloc(d_min=(double*)malloc(sizeof(double)*comp));
+  check_alloc(d_max=(double*)malloc(sizeof(double)*comp));
+  d_max_max=0.0;
+  for (i=0;i<comp;i++) {
+    rescale_data(series[i],length,&d_min[i],&d_max[i]);
+    if (d_max[i] > d_max_max)
+      d_max_max=d_max[i];
+  }
+
+  if (!eps_set)
+    mineps=1./1000.;
+  else
+    mineps /= d_max_max;
+  epsfac=sqrt(2.0);
+
+  check_alloc(box=(long**)malloc(sizeof(long*)*BOX));
+  for (i=0;i<BOX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*BOX));
+
+  check_alloc(list=(long*)malloc(sizeof(long)*length));
+  check_alloc(flist=(unsigned long*)malloc(sizeof(long)*length));
+
+  check_alloc(metric=(double*)malloc(sizeof(double)*dim));
+  trace=0.0;
+  if (euclidean) {
+    for (i=0;i<dim;i++) {
+      metric[i]=1.0;
+      trace += 1./metric[i];
+    }
+  }
+  else {
+    for (i=0;i<dim;i++) {
+      if ((i >= comp) && (i < ((long)dim-(long)comp))) 
+	metric[i]=1.0;
+      else 
+	metric[i]=1.0e3;
+      trace += 1./metric[i];
+    }
+  }
+
+  check_alloc(corr=(double**)malloc(sizeof(double*)*length));
+  for (i=0;i<length;i++)
+    check_alloc(corr[i]=(double*)malloc(sizeof(double)*dim));
+  check_alloc(ok=(int*)malloc(sizeof(int)*length));
+  check_alloc(delta=(double**)malloc(sizeof(double*)*comp));
+  for (i=0;i<comp;i++)
+    check_alloc(delta[i]=(double*)malloc(sizeof(double)*length));
+  check_alloc(index_comp=(unsigned int*)malloc(sizeof(int)*dim));
+  check_alloc(index_embed=(unsigned int*)malloc(sizeof(int)*dim));
+  check_alloc(av=(double*)malloc(sizeof(double)*dim));
+  check_alloc(sorted=(int*)malloc(sizeof(int)*dim));
+  check_alloc(eig=(double*)malloc(sizeof(double)*dim));
+  check_alloc(matarray=(double*)malloc(sizeof(double)*dim*dim));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++)
+    mat[i]=(double*)(matarray+dim*i);
+  check_alloc(hser=(double**)malloc(sizeof(double*)*comp));
+
+  for (i=0;i<dim;i++) {
+    index_comp[i]=i%comp;
+    index_embed[i]=(i/comp)*delay;
+  }
+
+  resize_eps=0;
+  for (iter=1;iter<=iterations;iter++) {
+    for (i=0;i<length;i++) {
+      ok[i]=0;
+      for (j=0;j<dim;j++)
+	corr[i][j]=0.0;
+      for (j=0;j<comp;j++)
+	delta[j][i]=0.0;
+    }
+    epsilon=mineps;
+    all_done=0;
+    epscount=1;
+    allfound=0;
+    if (verbosity&(VER_USR1|VER_USR2))
+      fprintf(stderr,"Starting iteration %d\n",iter);
+    while(!all_done) {
+      mmb(epsilon);
+      all_done=1;
+      for (n=emb_offset;n<length;n++)
+	if (!ok[n]) {
+	  nfound=fmn(n,epsilon);
+	  if (nfound >= minn) {
+	    make_correction(n,nfound);
+	    ok[n]=epscount;
+	    if (epscount == 1)
+	      resize_eps=1;
+	    allfound++;
+	  }
+	  else
+	    all_done=0;
+	}
+      if (verbosity&VER_USR2)
+	fprintf(stderr,"Corrected %ld points with epsilon= %e\n",allfound,
+		epsilon*d_max_max);
+      epsilon *= epsfac;
+      epscount++;
+    }
+    if (verbosity&VER_USR2)
+      fprintf(stderr,"Start evaluating the trend\n");
+
+    epsilon=mineps;
+    allfound=0;
+    for (i=1;i<epscount;i++) {
+      mmb(epsilon);
+      for (n=emb_offset;n<length;n++)
+	if (ok[n] == i) {
+	  nfound=fmn(n,epsilon);
+	  handle_trend(n,nfound);
+	  allfound++;
+	}
+      if (verbosity&VER_USR2)
+	fprintf(stderr,"Trend subtracted for %ld points with epsilon= %e\n",
+		allfound,epsilon*d_max_max);
+      epsilon *= epsfac;
+    }
+    set_correction();
+    
+    sprintf(ofname,"%s.%d",outfile,iter);
+    test_outfile(ofname);
+
+    file=fopen(ofname,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n\n",ofname);
+    for (i=0;i<length;i++) {
+      for (j=0;j<comp;j++) {
+	fprintf(file,"%e ",series[j][i]*d_max[j]+d_min[j]);
+      }
+      fprintf(file,"\n");
+      if (stdo && (iter == iterations)) {
+	for (j=0;j<comp;j++)
+	  fprintf(stdout,"%e ",series[j][i]*d_max[j]+d_min[j]);
+	fprintf(stdout,"\n");
+      }
+    }
+    fclose(file);
+  }
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/histogram.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/histogram.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,170 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified Dec 6, 2005*/
+/*Changes:
+  12/06/05: shift output x value to center of interval
+*/
+#include <math.h>
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Makes a histogram of the data"
+
+unsigned long length=ULONG_MAX;
+unsigned long base=50;
+unsigned long exclude=0;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+double size;
+char my_stdout=1,gotsize=0;
+char *outfile=NULL;
+char *infile=NULL;
+
+double *series;
+double average,var;
+double min,max;
+long *box;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted as a"
+	  " possible datafile.\nIf no datafile is given stdin is read. "
+	  " Just - also means stdin\n");
+  fprintf(stderr,"\t-l length of file [default whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [default %ld]\n",exclude);
+  fprintf(stderr,"\t-c column to read [default %d]\n",column);
+  fprintf(stderr,"\t-b # of intervals [default %ld]\n",base);
+  fprintf(stderr,"\t-o output file [default 'datafile'.dat ;"
+	  " If no -o is given: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **str)
+{
+  char *out;
+
+  if ((out=check_option(str,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(str,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(str,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(str,n,'b','u')) != NULL)
+    sscanf(out,"%lu",&base);
+  if ((out=check_option(str,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(str,n,'o','o')) != NULL) {
+    my_stdout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  unsigned long i,j;
+  double x,norm,size=1.0,size2=1.0;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,1));
+      strcpy(outfile,infile);
+      strcat(outfile,".his");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,1));
+      strcpy(outfile,"stdin.his");
+    }
+  }
+  if (!my_stdout)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  variance(series,length,&average,&var);
+  rescale_data(series,length,&min,&max);
+  
+  
+  if (base > 0) {
+    check_alloc(box=(long*)malloc(sizeof(long)*base));
+    for (i=0;i<base;i++)
+      box[i]=0;
+    size=1./base;
+    size2=size/2.0;
+    for (i=0;i<length;i++) {
+      if (series[i] > (1.0-size2))
+	series[i]=1.0-size2;
+      j=(long)(series[i]*base);
+      box[j]++;
+    }
+  }
+
+  norm=1.0/(double)length;
+  if (!my_stdout) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(fout,"#interval of data: [%e:%e]\n",min,max+min);
+    fprintf(fout,"#average= %e\n",average);
+    fprintf(fout,"#standard deviation= %e\n",var);
+    for (i=0;i<base;i++) {
+      x=(double)(i*size);
+      fprintf(fout,"%e %e\n",(x+size2)*max+min,(double)box[i]*norm);
+    }
+    fclose(fout);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"#interval of data: [%e:%e]\n",min,max+min);
+    fprintf(stdout,"#average= %e\n",average);
+    fprintf(stdout,"#standard deviation= %e\n",var);
+    for (i=0;i<base;i++) {
+      x=(double)(i*size);
+      fprintf(stdout,"%e %e\n",(x+size2)*max+min,(double)box[i]*norm);
+      fflush(stdout);
+    }
+  }
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lfo-ar.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lfo-ar.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,390 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Jun 21, 2005 */
+/*changes:
+  Jun 17, 2005: Comments in the output file updated
+  Jun 21, 2005: free imat in make_fit
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+#include <math.h>
+
+#define WID_STR "Estimates the average forecast error for a local\n\t\
+linear fit as a function of the neighborhood size."
+
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 256
+
+unsigned int nmax=(NMAX-1);
+long **box,*list;
+unsigned long *found;
+double *error;
+double **series;
+
+char eps0set=0,eps1set=0,causalset=0,dimset=0;
+char *outfile=NULL,stdo=1;
+char *column=NULL;
+unsigned int dim=1,embed=2,delay=1;
+unsigned int verbosity=0xff;
+int STEP=1;
+double EPS0=1.e-3,EPS1=1.0,EPSF=1.2;
+unsigned long LENGTH=ULONG_MAX,exclude=0,CLENGTH=ULONG_MAX,causal;
+char *infile=NULL;
+double **mat,*vec,*localav,*foreav,*hvec;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1,...,# of components]\n");
+  fprintf(stderr,"\t-m # of components,embedding dimension [default: 1,2]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-i iterations [default: length]\n");
+  fprintf(stderr,"\t-r neighborhood size to start with [default:"
+	  " (interval of data)/1000)]\n");
+  fprintf(stderr,"\t-R neighborhood size to end with [default:"
+	  " interval of data]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-C width of causality window [default: steps]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile.ll']\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&dim,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'i','u')) != NULL)
+    sscanf(out,"%lu",&CLENGTH);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    eps0set=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'R','f')) != NULL) {
+    eps1set=1;
+    sscanf(out,"%lf",&EPS1);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'C','u')) != NULL) {
+    sscanf(out,"%lu",&causal);
+    causalset=1;
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void multiply_matrix(double **mat,double *vec)
+{
+  long i,j;
+
+  for (i=0;i<dim*embed;i++) {
+    hvec[i]=0.0;
+    for (j=0;j<dim*embed;j++)
+      hvec[i] += mat[i][j]*vec[j];
+  }
+  for (i=0;i<dim*embed;i++)
+    vec[i]=hvec[i];
+}
+
+void make_fit(long act,unsigned long number)
+{
+  double *si,*sj,lavi,lavj,fav,**imat,cast;
+  long i,i1,hi,hi1,j,j1,hj,hj1,n,which;
+  
+  for (i=0;i<embed*dim;i++)
+    localav[i]=0;
+  for (i=0;i<dim;i++)
+    foreav[i]=0.0;
+  
+  for (n=0;n<number;n++) {
+    which=found[n];
+    for (j=0;j<dim;j++) {
+      sj=series[j];
+      foreav[j] += sj[which+STEP];
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	localav[hj] += sj[which-j1*delay];
+      }
+    }
+  }
+
+  for (i=0;i<dim*embed;i++)
+    localav[i] /= number;
+  for (i=0;i<dim;i++)
+    foreav[i] /= number;
+
+  for (i=0;i<dim;i++) {
+    si=series[i];
+    for (i1=0;i1<embed;i1++) {
+      hi=i*embed+i1;
+      lavi=localav[hi];
+      hi1=i1*delay;
+      for (j=0;j<dim;j++) {
+	sj=series[j];
+	for (j1=0;j1<embed;j1++) {
+	  hj=j*embed+j1;
+	  lavj=localav[hj];
+	  hj1=j1*delay;
+	  mat[hi][hj]=0.0;
+	  if (hj >= hi) {
+	    for (n=0;n<number;n++) {
+	      which=found[n];
+	      mat[hi][hj] += (si[which-hi1]-lavi)*(sj[which-hj1]-lavj);
+	    }
+	  }
+	}
+      }
+    }
+  }
+  
+  for (i=0;i<dim*embed;i++)
+    for (j=i;j<dim*embed;j++) {
+      mat[i][j] /= number;
+      mat[j][i]=mat[i][j];
+    }
+  
+  imat=invert_matrix(mat,dim*embed);
+
+  for (i=0;i<dim;i++) {
+    si=series[i];
+    fav=foreav[i];
+    for (j=0;j<dim;j++) {
+      sj=series[j];
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	lavj=localav[hj];
+	hj1=j1*delay;
+	vec[hj]=0.0;
+	for (n=0;n<number;n++) {
+	  which=found[n];
+	  vec[hj] += (si[which+STEP]-fav)*(sj[which-hj1]-lavj);
+	}
+	vec[hj] /= number;
+      }
+    }
+
+    multiply_matrix(imat,vec);
+
+    cast=foreav[i];
+    for (j=0;j<dim;j++) {
+      sj=series[j];
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	cast += vec[hj]*(sj[act-j1*delay]-localav[hj]);
+      }
+    }
+    error[i] += sqr(cast-series[i][act+STEP]);
+  }
+  for (i=0;i<embed*dim;i++)
+    free(imat[i]);
+  free(imat);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  unsigned long actfound;
+  unsigned long *hfound;
+  long pfound,i,j;
+  unsigned long clength;
+  double interval,min,maxinterval;
+  double epsilon;
+  double **hser;
+  double avfound,*hrms,*hav,sumerror=0.0;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  if (!causalset)
+    causal=STEP;
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+      sprintf(outfile,"%s.ll",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)9,(size_t)1));
+      sprintf(outfile,"stdin.ll");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,column,
+				      dimset,verbosity);
+  maxinterval=0.0;
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],LENGTH,&min,&interval);
+    if (interval > maxinterval)
+      maxinterval=interval;
+  }
+  interval=maxinterval;
+
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(hfound=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+  check_alloc(vec=(double*)malloc(sizeof(double)*(embed*dim)));
+  check_alloc(hvec=(double*)malloc(sizeof(double)*(embed*dim)));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*(embed*dim)));
+  for (i=0;i<dim*embed;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*(embed*dim)));
+  check_alloc(error=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hrms=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hav=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hser=(double**)malloc(sizeof(double*)*dim));
+  check_alloc(foreav=(double*)malloc(sizeof(double)*dim));
+  check_alloc(localav=(double*)malloc(sizeof(double)*(embed*dim)));
+  
+  if (eps0set)
+    EPS0 /= interval;
+  if (eps1set)
+    EPS1 /= interval;
+
+  clength=(CLENGTH <= LENGTH) ? CLENGTH-STEP : LENGTH-STEP;
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(file,"#1.) neighborhood size\n");
+    fprintf(file,"#2.) average relative forecast error\n");
+    fprintf(file,"#next n.) relative forecast error of the n components\n");
+    fprintf(file,"#second last.) fraction of points with enough neighbors\n");
+    fprintf(file,"#last .) average number of neighbors used for the fit\n");
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  for (epsilon=EPS0;epsilon<EPS1*EPSF;epsilon*=EPSF) {
+    pfound=0;
+    for (i=0;i<dim;i++)
+      error[i]=hrms[i]=hav[i]=0.0;
+    avfound=0.0;
+    make_multi_box(series,box,list,LENGTH-STEP,NMAX,dim,
+		   embed,delay,epsilon);
+    for (i=(embed-1)*delay;i<clength;i++) {
+      for (j=0;j<dim;j++)
+	hser[j]=series[j]+i;
+      actfound=find_multi_neighbors(series,box,list,hser,LENGTH,
+				    NMAX,dim,embed,delay,epsilon,hfound);
+      actfound=exclude_interval(actfound,i-causal+1,i+causal+(embed-1)*delay-1,
+				hfound,found);
+      if (actfound > 2*(dim*embed+1)) {
+	make_fit(i,actfound);
+	pfound++;
+	avfound += (double)(actfound-1);
+	for (j=0;j<dim;j++) {
+	  hrms[j] += series[j][i+STEP]*series[j][i+STEP];
+	  hav[j] += series[j][i+STEP];
+	}
+      }
+    }
+    if (pfound > 1) {
+      sumerror=0.0;
+      for (j=0;j<dim;j++) {
+	hav[j] /= pfound;
+	hrms[j]=sqrt(fabs(hrms[j]/(pfound-1)-hav[j]*hav[j]*pfound/(pfound-1)));
+	error[j]=sqrt(error[j]/pfound)/hrms[j];
+	sumerror += error[j];
+      }
+    }
+    if (stdo) {
+      if (pfound > 1) {
+	fprintf(stdout,"%e %e ",epsilon*interval,sumerror/(double)dim);
+	for (j=0;j<dim;j++)
+	  fprintf(stdout,"%e ",error[j]);
+	fprintf(stdout,"%e %e\n",(double)pfound/(clength-(embed-1)*delay),
+		avfound/pfound);
+	fflush(stdout);
+      }
+    }
+    else {
+      if (pfound > 1) {
+	fprintf(file,"%e %e ",epsilon*interval,sumerror/(double)dim);
+	for (j=0;j<dim;j++)
+	  fprintf(file,"%e ",error[j]);
+	fprintf(file,"%e %e\n",(double)pfound/(clength-(embed-1)*delay),
+		avfound/pfound);
+	fflush(file);
+      }
+    }
+  }
+  if (!stdo)
+    fclose(file);
+  
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lfo-run.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lfo-run.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,456 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 29, 2000 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Makes a local linear fit for multivariate data\n\
+and iterates a trajectory"
+
+#define NMAX 128
+
+char onscreen=1,epsset=0,*outfile=NULL;
+char *infile=NULL;
+unsigned int nmax=(NMAX-1);
+unsigned int verbosity=0xff;
+long **box,*list,*found;
+double **series,**cast;
+double *interval,*min,epsilon;
+
+unsigned int embed=2,dim=1,dim1,DELAY=1;
+char *column=NULL,dimset=0,do_zeroth=0;
+int MINN=30;
+unsigned long LENGTH=ULONG_MAX,FLENGTH=1000,exclude=0;
+double EPS0=1.e-3,EPSF=1.2;
+
+double **mat,**imat,*vec,*localav,*foreav;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to be used [default whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default 0]\n");
+  fprintf(stderr,"\t-c column [default 1,...,# of components]\n");
+  fprintf(stderr,"\t-m #of components,embedding dimension [default 1,2]\n");
+  fprintf(stderr,"\t-d delay for the embedding [default 1]\n");
+  fprintf(stderr,"\t-L # of iterations [default 1000]\n");
+  fprintf(stderr,"\t-k # of neighbors  [default 30]\n");
+  fprintf(stderr,"\t-r size of initial neighborhood ["
+	  " default (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default 1.2]\n");
+  fprintf(stderr,"\t-0 perfom a zeroth order fit [default not set]\n");
+  fprintf(stderr,"\t-o output file [default 'datafile'.cast;"
+	  " no -o means write to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h  show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&dim,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'L','u')) != NULL)
+    sscanf(out,"%lu",&FLENGTH);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'0','n')) != NULL)
+    do_zeroth=1;
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    onscreen=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void put_in_boxes(void)
+{
+  int i,j,n;
+  static int hdim;
+  double epsinv;
+
+  hdim=(embed-1)*DELAY;
+  epsinv=1.0/epsilon;
+  for (i=0;i<NMAX;i++)
+    for (j=0;j<NMAX;j++)
+      box[i][j]= -1;
+
+  for (n=hdim;n<LENGTH-1;n++) {
+    i=(int)(series[0][n]*epsinv)&nmax;
+    j=(int)(series[dim1][n-hdim]*epsinv)&nmax;
+    list[n]=box[i][j];
+    box[i][j]=n;
+  }
+}
+
+unsigned int hfind_neighbors(void)
+{
+  char toolarge;
+  int i,j,i1,i2,j1,k,l,element;
+  static int hdim;
+  unsigned nfound=0;
+  double max,dx,epsinv;
+
+  hdim=(embed-1)*DELAY;
+  epsinv=1.0/epsilon;
+  i=(int)(cast[hdim][0]*epsinv)&nmax;
+  j=(int)(cast[0][dim1]*epsinv)&nmax;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&nmax;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&nmax];
+      while (element != -1) {
+	max=0.0;
+	toolarge=0;
+	for (l=0;l<dim;l++) {
+	  for (k=0;k<=hdim;k += DELAY) {
+	    dx=fabs(series[l][element-k]-cast[hdim-k][l]);
+	    max=(dx>max) ? dx : max;
+	    if (max > epsilon) {
+	      toolarge=1;
+	      break;
+	    }
+	  }
+	  if (toolarge)
+	    break;
+	}
+	if (max <= epsilon)
+	  found[nfound++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nfound;
+}
+
+void multiply_matrix(double **mat,double *vec)
+{
+  double *hvec;
+  long i,j;
+
+  check_alloc(hvec=(double*)malloc(sizeof(double)*dim*embed));
+  for (i=0;i<dim*embed;i++) {
+    hvec[i]=0.0;
+    for (j=0;j<dim*embed;j++)
+      hvec[i] += mat[i][j]*vec[j];
+  }
+  for (i=0;i<dim*embed;i++)
+    vec[i]=hvec[i];
+  free(hvec);
+}
+
+void make_fit(int number,double *newcast)
+{
+  double *sj,*si,lavi,lavj,fav;
+  long i,i1,j,j1,hi,hj,hi1,hj1,n,which;
+  static int hdim;
+
+  hdim=(embed-1)*DELAY;
+
+  for (i=0;i<dim*embed;i++)
+    localav[i]=0.0;
+  for (i=0;i<dim;i++)
+    foreav[i]=0.0;
+
+  for (n=0;n<number;n++) {
+    which=found[n];
+    for (j=0;j<dim;j++) {
+      sj=series[j];
+      foreav[j] += sj[which+1];
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	localav[hj] += sj[which-j1*DELAY];
+      }
+    }
+  }
+
+  for (i=0;i<dim*embed;i++)
+    localav[i] /= number;
+  for (i=0;i<dim;i++)
+    foreav[i] /= number;
+
+  for (i=0;i<dim;i++) {
+    si=series[i];
+    for (i1=0;i1<embed;i1++) {
+      hi=i*embed+i1;
+      lavi=localav[hi];
+      hi1=i1*DELAY;
+      for (j=0;j<dim;j++) {
+	sj=series[j];
+	for (j1=0;j1<embed;j1++) {
+	  hj=j*embed+j1;
+	  lavj=localav[hj];
+	  hj1=j1*DELAY;
+	  mat[hi][hj]=0.0;
+	  if (hj >= hi) {
+	    for (n=0;n<number;n++) {
+	      which=found[n];
+	      mat[hi][hj] += (si[which-hi1]-lavi)*(sj[which-hj1]-lavj);
+	    }
+	  }
+	}
+      }
+    }
+  }
+  
+  for (i=0;i<dim*embed;i++)
+    for (j=i;j<dim*embed;j++) {
+      mat[i][j] /= number;
+      mat[j][i]=mat[i][j];
+    }
+  
+  imat=invert_matrix(mat,dim*embed);
+
+  for (i=0;i<dim;i++) {
+    si=series[i];
+    fav=foreav[i];
+    for (j=0;j<dim;j++) {
+      sj=series[j];
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	lavj=localav[hj];
+	hj1=j1*DELAY;
+	vec[hj]=0.0;
+	for (n=0;n<number;n++) {
+	  which=found[n];
+	  vec[hj] += (si[which+1]-fav)*(sj[which-hj1]-lavj);
+	}
+	vec[hj] /= number;
+      }
+    }
+
+    multiply_matrix(imat,vec);
+
+    newcast[i]=foreav[i];
+    for (j=0;j<dim;j++) {
+      for (j1=0;j1<embed;j1++) {
+	hj=j*embed+j1;
+	newcast[i] += vec[hj]*(cast[hdim-j1*DELAY][j]-localav[hj]);
+      }
+    }
+  }
+  
+  for (i=0;i<dim*embed;i++)
+    free(imat[i]);
+  free(imat);
+}
+
+void make_zeroth(int number,double *newcast)
+{
+  unsigned long i,d;
+  double *sj;
+  
+  for (d=0;d<dim;d++) {
+    newcast[d]=0.0;
+    sj=series[d]+1;
+    for (i=0;i<number;i++)
+      newcast[d] += sj[found[i]];
+    newcast[d] /= number;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0,done;
+  long i,j,hdim,actfound;
+  double maxinterval,*swap,*newcast;
+  FILE *file=NULL;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+  
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+6,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".cast");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)11,(size_t)1));
+      strcpy(outfile,"stdin.cast");
+    }
+  }
+  if (!onscreen)
+    test_outfile(outfile);
+  
+  hdim=(embed-1)*DELAY+1;
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,column,
+				      dimset,verbosity);
+  check_alloc(min=(double*)malloc(sizeof(double)*dim));
+  check_alloc(interval=(double*)malloc(sizeof(double)*dim));
+  dim1=dim-1;
+  maxinterval=0.0;
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],LENGTH,&min[i],&interval[i]);
+    if (interval[i] > maxinterval)
+      maxinterval=interval[i];
+  }
+  
+  check_alloc(cast=(double**)malloc(sizeof(double*)*hdim));
+  for (i=0;i<hdim;i++)
+    check_alloc(cast[i]=(double*)malloc(sizeof(double)*dim));
+  check_alloc(newcast=(double*)malloc(sizeof(double)*dim));
+    
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+  
+  check_alloc(localav=(double*)malloc(sizeof(double)*dim*embed));
+  check_alloc(foreav=(double*)malloc(sizeof(double)*dim));
+  check_alloc(vec=(double*)malloc(sizeof(double)*dim*embed));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*dim*embed));
+  for (i=0;i<dim*embed;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*dim*embed));
+
+  if (epsset)
+    EPS0 /= maxinterval;
+
+  for (j=0;j<dim;j++)
+    for (i=0;i<hdim;i++)
+      cast[i][j]=series[j][LENGTH-hdim+i];
+  
+  if (!onscreen) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  for (i=0;i<FLENGTH;i++) {
+    done=0;
+    epsilon=EPS0/EPSF;
+    while (!done) {
+      epsilon*=EPSF;
+      put_in_boxes();
+      actfound=hfind_neighbors();
+      if (actfound >= MINN) {
+	if (!do_zeroth)
+	  make_fit(actfound,newcast);
+	else
+	  make_zeroth(actfound,newcast);
+	if (onscreen) {
+	  for (j=0;j<dim-1;j++)
+	    printf("%e ",newcast[j]*interval[j]+min[j]);
+	  printf("%e\n",newcast[dim-1]*interval[dim-1]+min[dim-1]);
+	  fflush(stdout);
+	}
+	else {
+	  for (j=0;j<dim-1;j++)
+	    fprintf(file,"%e ",newcast[j]*interval[j]+min[j]);
+	  fprintf(file,"%e\n",newcast[dim-1]*interval[dim-1]+min[dim-1]);
+	  fflush(file);
+	}
+	done=1;
+	for (j=0;j<dim;j++) {
+	  if ((newcast[j] > 2.0) || (newcast[j] < -1.0)) {
+	    fprintf(stderr,"Forecast failed. Escaping data region!\n");
+	    exit(NSTEP__ESCAPE_REGION);
+	  }
+	}
+
+	swap=cast[0];
+	for (j=0;j<hdim-1;j++)
+	  cast[j]=cast[j+1];
+	cast[hdim-1]=swap;
+	for (j=0;j<dim;j++)
+	  cast[hdim-1][j]=newcast[j];
+      }
+    }
+  }
+  if (!onscreen)
+    fclose(file);
+  
+  if (outfile != NULL)
+    free(outfile);
+  for (i=0;i<embed*dim;i++)
+    free(mat[i]);
+  free(mat);
+  for (i=0;i<hdim;i++)
+    free(cast[i]);
+  free(cast);
+  free(newcast);
+  free(found);
+  free(list);
+  for (i=0;i<NMAX;i++)
+    free(box[i]);
+  free(box);
+  free(vec);
+  free(localav);
+  free(foreav);
+  free(min);
+  free(interval);
+  for (i=0;i<dim;i++)
+    free(series[i]);
+  free(series);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lfo-test.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lfo-test.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,462 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger */
+/*Changes:
+  Sep 8, 2006: Add -o functionality
+  Sep 7, 2006: Completely rewritten to handle multivariate data
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+#include <math.h>
+
+#define WID_STR "Estimates the average forecast error of a local\n\t\
+linear fit"
+
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 512
+
+unsigned int nmax=(NMAX-1),comp1,hdim,**indexes;
+long **box,*list;
+unsigned long *found,*hfound;
+double **series;
+double epsilon;
+double **mat,**imat,*vec,*localav,*foreav;
+
+char epsset=0,causalset=0;
+unsigned int verbosity=VER_INPUT|VER_FIRST_LINE;
+unsigned int COMP=1,EMBED=2,DIM,DELAY=1,MINN=30,STEP=1;
+double EPS0=1.e-3,EPSF=1.2;
+unsigned long LENGTH=ULONG_MAX,exclude=0,CLENGTH=ULONG_MAX,causal;
+char *infile=NULL,*COLUMN=NULL,*outfile=NULL;
+char dimset=0,stout=1;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1]\n");
+  fprintf(stderr,"\t-m # of components, embedding dimension "
+	  "[default: %u,%u]\n",COMP,EMBED);
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-n iterations [default: length]\n");
+  fprintf(stderr,"\t-k minimal number of neighbors for the fit "
+	  "[default: 30]\n");
+  fprintf(stderr,"\t-r neighborhoud size to start with "
+	  "[default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-C width of causality window [default: steps]\n");
+  fprintf(stderr,"\t-o output file [default 'datafile'.fce"
+	  " no -o means write to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+	  "2='+ print indiviual forecast errors'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    COLUMN=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&COMP,&EMBED);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&CLENGTH);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'C','u')) != NULL) {
+    sscanf(out,"%lu",&causal);
+    causalset=1;
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void put_in_boxes(void)
+{
+  int i,j,n;
+  double epsinv;
+
+  epsinv=1.0/epsilon;
+  for (i=0;i<NMAX;i++)
+    for (j=0;j<NMAX;j++)
+      box[i][j]= -1;
+
+  for (n=hdim;n<LENGTH-STEP;n++) {
+    i=(int)(series[0][n]*epsinv)&nmax;
+    j=(int)(series[comp1][n-hdim]*epsinv)&nmax;
+    list[n]=box[i][j];
+    box[i][j]=n;
+  }
+}
+
+unsigned int hfind_neighbors(unsigned long act)
+{
+  char toolarge;
+  int i,j,i1,i2,j1,k,element;
+  unsigned long nfound=0;
+  unsigned int hcomp,hdel;
+  double max,dx,epsinv;
+
+  epsinv=1.0/epsilon;
+
+  i=(int)(series[0][act]*epsinv)&nmax;
+  j=(int)(series[comp1][act-hdim]*epsinv)&nmax;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&nmax;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&nmax];
+      while (element != -1) {
+	max=0.0;
+	toolarge=0;
+	for (k=0;k<DIM;k += 1) {
+	  hcomp=indexes[0][k];
+	  hdel=indexes[1][k];
+	  dx=fabs(series[hcomp][element-hdel]-series[hcomp][act-hdel]);
+	  max=(dx>max) ? dx : max;
+	  if (max > epsilon) {
+	    toolarge=1;
+	    break;
+	  }
+	  if (toolarge)
+	    break;
+	}
+	if (max <= epsilon)
+	  hfound[nfound++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nfound;
+}
+
+void multiply_matrix(double **mat,double *vec)
+{
+  double *hvec;
+  long i,j;
+
+  check_alloc(hvec=(double*)malloc(sizeof(double)*DIM));
+  for (i=0;i<DIM;i++) {
+    hvec[i]=0.0;
+    for (j=0;j<DIM;j++)
+      hvec[i] += mat[i][j]*vec[j];
+  }
+  for (i=0;i<DIM;i++)
+    vec[i]=hvec[i];
+  free(hvec);
+}
+
+void make_fit(int number,unsigned long act,double *newcast)
+{
+  double *sj,*si,lavi,lavj,fav;
+  unsigned int hci,hdi,hcj,hdj;
+  long i,j,n,which;
+
+  for (i=0;i<DIM;i++)
+    localav[i]=0.0;
+  for (i=0;i<COMP;i++)
+    foreav[i]=0.0;
+
+  for (n=0;n<number;n++) {
+    which=found[n];
+    for (j=0;j<COMP;j++)
+      foreav[j] += series[j][which+STEP];
+    for (j=0;j<DIM;j++) {
+      hcj=indexes[0][j];
+      hdj=indexes[1][j];
+      localav[j] += series[hcj][which-hdj];
+    }
+  }
+
+  for (i=0;i<DIM;i++)
+    localav[i] /= number;
+  for (i=0;i<COMP;i++)
+    foreav[i] /= number;
+
+  for (i=0;i<DIM;i++) {
+    hci=indexes[0][i];
+    hdi=indexes[1][i];
+    lavi=localav[i];
+    si=series[hci];
+    for (j=i;j<DIM;j++) {
+      hcj=indexes[0][j];
+      hdj=indexes[1][j];
+      lavj=localav[j];
+      sj=series[hcj];
+      mat[i][j]=0.0;
+      for (n=0;n<number;n++) {
+	which=found[n];
+	mat[i][j] += (si[which-hdi]-lavi)*(sj[which-hdj]-lavj);
+      }
+      mat[i][j] /= number;
+      mat[j][i] = mat[i][j];
+    }
+  }
+
+  imat=invert_matrix(mat,DIM);
+
+  for (i=0;i<COMP;i++) {
+    si=series[i];
+    fav=foreav[i];
+    for (j=0;j<DIM;j++) {
+      hcj=indexes[0][j];
+      hdj=indexes[1][j];
+      lavj=localav[j];
+      vec[j]=0.0;
+      sj=series[hcj];
+      for (n=0;n<number;n++) {
+	which=found[n];
+	vec[j] += (si[which+STEP]-fav)*(sj[which-hdj]);
+      }
+      vec[j] /= number;
+    }
+
+    multiply_matrix(imat,vec);
+
+    newcast[i]=foreav[i];
+    for (j=0;j<DIM;j++) {
+      hcj=indexes[0][j];
+      hdj=indexes[1][j];
+      newcast[i] += vec[j]*(series[hcj][act-hdj]-localav[j]);
+    }
+  }
+  
+
+  for (i=0;i<DIM;i++)
+    free(imat[i]);
+  free(imat);
+}
+
+int main(int argc,char **argv)
+{
+  char stin=0,alldone,*done;
+  long i,j;
+  unsigned long actfound;
+  unsigned long clength;
+  double *rms,*av,*min,*interval,maxinterval,norm;
+  double *error,**individual=NULL;
+  double *newcast;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+
+  if (!causalset)
+    causal=STEP;
+
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stin=1;
+  
+  if (outfile == NULL) {
+    if (!stin) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".fce");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.fce");
+    }
+  }
+  if (!stout)
+    test_outfile(outfile);
+  
+  if (COLUMN == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&COMP,"",dimset,
+                                      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&COMP,COLUMN,
+                                      dimset,verbosity);
+
+  if ((LENGTH-(EMBED-1)*DELAY) < MINN) {
+    fprintf(stderr,"Data set is too short to find enough neighbors "
+	    "for the fit! Exiting!\n");
+    exit(ONESTEP_TOO_FEW_POINTS);
+  }
+
+  DIM=EMBED*COMP;
+  check_alloc(min=(double*)malloc(sizeof(double)*COMP));
+  check_alloc(interval=(double*)malloc(sizeof(double)*COMP));
+  check_alloc(av=(double*)malloc(sizeof(double)*COMP));
+  check_alloc(rms=(double*)malloc(sizeof(double)*COMP));
+
+  maxinterval=0.0;
+  for (i=0;i<COMP;i++) {
+    rescale_data(series[i],LENGTH,&min[i],&interval[i]);
+    maxinterval=(maxinterval<interval[i])?interval[i]:maxinterval;
+    variance(series[i],LENGTH,&av[i],&rms[i]);
+  }
+  
+  if (verbosity&VER_USR1) {
+    check_alloc(individual=(double**)malloc(sizeof(double*)*COMP));
+    for (j=0;j<COMP;j++) {
+      check_alloc(individual[j]=(double*)malloc(sizeof(double)*LENGTH));
+      for (i=0;i<LENGTH;i++)
+	individual[j][i]=0.0;
+    }
+  }
+
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(hfound=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(done=(char*)malloc(sizeof(char)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+    
+  for (i=0;i<LENGTH;i++)
+    done[i]=0;
+
+  alldone=0;
+  if (epsset)
+    EPS0 /= maxinterval;
+
+  epsilon=EPS0/EPSF;
+  clength=(CLENGTH <= LENGTH) ? CLENGTH-STEP : LENGTH-STEP;
+  comp1=COMP-1;
+  indexes=make_multi_index(COMP,EMBED,DELAY);
+
+  hdim=(EMBED-1)*DELAY;
+  check_alloc(newcast=(double*)malloc(sizeof(double)*COMP));
+
+
+  check_alloc(localav=(double*)malloc(sizeof(double)*DIM));
+  check_alloc(foreav=(double*)malloc(sizeof(double)*COMP));
+  check_alloc(vec=(double*)malloc(sizeof(double)*DIM));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*DIM));
+  for (i=0;i<=DIM;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*DIM));
+
+  check_alloc(error=(double*)malloc(sizeof(double)*COMP));
+  for (i=0;i<COMP;i++)
+    error[i]=0.0;
+
+  while (!alldone) {
+    alldone=1;
+    epsilon*=EPSF;
+    put_in_boxes() ;
+    for (i=(EMBED-1)*DELAY;i<clength;i++)
+      if (!done[i]) {
+	actfound=hfind_neighbors(i);
+	actfound=exclude_interval(actfound,i-causal+1,
+				  i+causal+(EMBED-1)*DELAY-1,hfound,found);
+	if (actfound > MINN) {
+	  make_fit(actfound,i,newcast);
+	  for (j=0;j<COMP;j++)
+	    error[j] += sqr(newcast[j]-series[j][i+STEP]);
+	  if (verbosity&VER_USR1) {
+	    for (j=0;j<COMP;j++)
+	      individual[j][i]=(newcast[j]-series[j][i+STEP])*interval[j];
+	  }
+	  done[i]=1;
+	}
+	alldone &= done[i];
+      }
+  }
+  norm=((double)clength-(double)((EMBED-1)*DELAY));
+  if (stout) {
+    if (verbosity&VER_USR1) {
+      fprintf(stdout,"#Relative forecast errors for each component:\n");
+      for (i=0;i<COMP;i++) 
+	fprintf(stdout,"# %e\n",sqrt(error[i]/norm)/rms[i]);
+    
+      for (i=(EMBED-1)*DELAY;i<clength;i++) {
+	for (j=0;j<COMP-1;j++)
+	  fprintf(stdout,"%e ",individual[j][i]);
+	fprintf(stdout,"%e\n",individual[COMP-1][i]);
+      }
+    }
+    else {
+      fprintf(stdout,"#Relative forecast errors for each component:\n");
+      for (i=0;i<COMP;i++) 
+	fprintf(stdout,"%e\n",sqrt(error[i]/norm)/rms[i]);
+    }
+  }
+  else {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    if (verbosity&VER_USR1) {
+      fprintf(fout,"#Relative forecast errors for each component:\n");
+      for (i=0;i<COMP;i++) 
+	fprintf(fout,"# %e\n",sqrt(error[i]/norm)/rms[i]);
+    
+      for (i=(EMBED-1)*DELAY;i<clength;i++) {
+	for (j=0;j<COMP-1;j++)
+	  fprintf(fout,"%e ",individual[j][i]);
+	fprintf(fout,"%e\n",individual[COMP-1][i]);
+      }
+    }
+    else {
+      fprintf(fout,"#Relative forecast errors for each component:\n");
+      for (i=0;i<COMP;i++) 
+	fprintf(fout,"%e\n",sqrt(error[i]/norm)/rms[i]);
+    }
+    fclose(fout);
+    free(outfile);
+  }
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/low121.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/low121.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,173 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Dec 17, 2001 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Simple lowpass filter in the time domain"
+
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int column=1,iterations=1;
+unsigned int verbosity=0x1;
+char *outfile=NULL,stdo=1;
+char *infile=NULL;
+
+double *series,*new;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of points to use [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default: 0]\n");
+  fprintf(stderr,"\t-c column to read [Default: 1]\n");
+  fprintf(stderr,"\t-i # of iterations [Default: 1]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+          "2='+ print each iteration to a separate file\n");
+  fprintf(stderr,"\t-o output file name(s) [Default: 'datafile'.low.n,\n\t\t"
+	  "where n is the number of the iteration.\n\t\t"
+	  "without -o the last iteration is written to stdout.]\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(in,n,'i','u')) != NULL)
+    sscanf(out,"%u",&iterations);
+  if ((out=check_option(in,n,'V','d')) != NULL)
+    sscanf(out,"%d",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  char *ofname;
+  unsigned long i;
+  unsigned int iter;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) { 
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      check_alloc(ofname=(char*)calloc(strlen(infile)+9,(size_t)1));
+      sprintf(outfile,"%s.low",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      check_alloc(ofname=(char*)calloc((size_t)14,(size_t)1));
+      sprintf(outfile,"stdin.low");
+    }
+  }
+  else
+    check_alloc(ofname=(char*)calloc(strlen(outfile)+10,(size_t)1));
+  
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  check_alloc(new=(double*)malloc(sizeof(double)*length));
+  
+  if (verbosity&VER_USR1) {
+    for (iter=1;iter<=iterations;iter++) {
+      new[0]=(2.0*series[0]+2.0*series[1])/4.0;
+      new[length-1]=(2.0*series[length-1]+2.0*series[length-2])/4.0;
+      for (i=1;i<length-1;i++)
+	new[i]=(series[i-1]+2.0*series[i]+series[i+1])/4.0;
+	sprintf(ofname,"%s.%d",outfile,iter);
+	test_outfile(ofname);
+	file=fopen(ofname,"w");
+	if (verbosity&VER_INPUT)
+	  fprintf(stderr,"Opened %s for writing\n",ofname);
+	if (stdo && (iter == iterations)) {
+	  if (verbosity&VER_INPUT)
+	    fprintf(stderr,"Writing to stdout\n");
+	}
+	for (i=0;i<length;i++) {
+	  if (stdo && (iter == iterations))
+	    fprintf(stdout,"%e\n",series[i]=new[i]);
+	  fprintf(file,"%e\n",series[i]=new[i]);
+	}
+	fclose(file);
+    }
+  }
+  else {
+    for (iter=1;iter<=iterations;iter++) {
+      new[0]=(2.0*series[0]+2.0*series[1])/4.0;
+      new[length-1]=(2.0*series[length-1]+2.0*series[length-2])/4.0;
+      for (i=1;i<length-1;i++)
+	new[i]=(series[i-1]+2.0*series[i]+series[i+1])/4.0;
+      for (i=0;i<length;i++)
+	series[i]=new[i];
+    }
+    if (!stdo) {
+      sprintf(ofname,"%s.%d",outfile,iterations);
+      file=fopen(ofname,"w");
+      if (verbosity&VER_INPUT)
+	fprintf(stderr,"Opened %s for writing\n",ofname);
+      for (i=0;i<length;i++)
+	fprintf(file,"%e\n",series[i]);
+      fclose(file);
+    }
+    else {
+      if (verbosity&VER_INPUT)
+	fprintf(stderr,"Writing to stdout\n");
+      for (i=0;i<length;i++)
+	fprintf(stdout,"%e\n",series[i]);
+    }
+  }
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lyap_k.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lyap_k.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,341 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 3, 1999*/
+#include <math.h>
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the maximal Lyapunov exponent using the Kantz\n\t\
+algorithm"
+
+#define BOX 128
+const unsigned int ibox=BOX-1;
+
+unsigned long length=ULONG_MAX;
+unsigned long exclude=0;
+unsigned long reference=ULONG_MAX;
+unsigned int maxdim=2;
+unsigned int mindim=2;
+unsigned int delay=1;
+unsigned int column=1;
+unsigned int epscount=5;
+unsigned int maxiter=50;
+unsigned int window=0;
+unsigned int verbosity=0xff;
+double epsmin=1.e-3,epsmax=1.e-2;
+char eps0set=0,eps1set=0;
+char *outfile=NULL;
+char *infile=NULL;
+
+double *series,**lyap;
+long box[BOX][BOX],*liste,**lfound,*found,**count;
+double max,min;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be "
+	  "interpreted as a possible datafile.\nIf no datafile "
+	  "is given stdin is read. Just - also means stdin\n");
+  fprintf(stderr,"\t-l # of data [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c column to read [default: 1]\n");
+  fprintf(stderr,"\t-M maxdim [default: 2]\n");
+  fprintf(stderr,"\t-m mindim [default: 2]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-r mineps [default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-R maxeps [default: (data interval)/100]\n");
+  fprintf(stderr,"\t-# # of eps [default: 5]\n");
+  fprintf(stderr,"\t-n # of reference points [default: # of data]\n");
+  fprintf(stderr,"\t-s # of iterations [default: 50]\n");
+  fprintf(stderr,"\t-t time window [default: 0]\n");
+  fprintf(stderr,"\t-o outfile [default: 'datafile'.lyap]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 3]\n\t\t"
+	  "0='only panic messages'\n\t\t"
+	  "1='+ input/output messages'\n\t\t"
+	  "2='+ plus statistics'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **str)
+{
+  char *out;
+  
+  if ((out=check_option(str,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(str,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(str,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(str,n,'M','u')) != NULL)
+    sscanf(out,"%u",&maxdim);
+  if ((out=check_option(str,n,'m','u')) != NULL)
+    sscanf(out,"%u",&mindim);
+  if ((out=check_option(str,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(str,n,'r','f')) != NULL) {
+    eps0set=1;
+    sscanf(out,"%lf",&epsmin);
+  }
+  if ((out=check_option(str,n,'R','f')) != NULL) {
+    eps1set=1;
+    sscanf(out,"%lf",&epsmax);
+  }
+  if ((out=check_option(str,n,'#','u')) != NULL)
+    sscanf(out,"%u",&epscount);
+  if ((out=check_option(str,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&reference);
+  if ((out=check_option(str,n,'s','u')) != NULL)
+    sscanf(out,"%u",&maxiter);
+  if ((out=check_option(str,n,'t','u')) != NULL)
+    sscanf(out,"%u",&window);
+  if ((out=check_option(str,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(str,n,'o','o')) != NULL)
+    if (strlen(out) > 0)
+      outfile=out;
+}
+
+void put_in_boxes(double eps)
+{
+  unsigned long i;
+  long j,k;
+  static unsigned long blength;
+
+  blength=length-(maxdim-1)*delay-maxiter;
+
+  for (i=0;i<BOX;i++)
+    for (j=0;j<BOX;j++)
+      box[i][j]= -1;
+
+  for (i=0;i<blength;i++) {
+    j=(long)(series[i]/eps)&ibox;
+    k=(long)(series[i+delay]/eps)&ibox;
+    liste[i]=box[j][k];
+    box[j][k]=i;
+  }
+}
+
+void lfind_neighbors(long act,double eps)
+{
+  unsigned int hi,k,k1;
+  long i,j,i1,i2,j1,element;
+  static long lwindow;
+  double dx,eps2=sqr(eps);
+
+  lwindow=(long)window;
+  for (hi=0;hi<maxdim-1;hi++)
+    found[hi]=0;
+  i=(long)(series[act]/eps)&ibox;
+  j=(long)(series[act+delay]/eps)&ibox;
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&ibox;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&ibox];
+      while (element != -1) {
+	if ((element < (act-lwindow)) || (element > (act+lwindow))) {
+	  dx=sqr(series[act]-series[element]);
+	  if (dx <= eps2) {
+	    for (k=1;k<maxdim;k++) {
+	      k1=k*delay;
+	      dx += sqr(series[act+k1]-series[element+k1]);
+	      if (dx <= eps2) {
+		k1=k-1;
+		lfound[k1][found[k1]]=element;
+		found[k1]++;
+	      }
+	      else
+		break;
+	    }
+	  }
+	}
+	element=liste[element];
+      }
+    }
+  }
+}
+
+void iterate_points(long act)
+{
+  double **lfactor;
+  double *dx;
+  unsigned int i,j,l,l1;
+  long k,element,**lcount;
+  
+  check_alloc(lfactor=(double**)malloc(sizeof(double*)*(maxdim-1)));
+  check_alloc(lcount=(long**)malloc(sizeof(long*)*(maxdim-1)));
+  for (i=0;i<maxdim-1;i++) {
+    check_alloc(lfactor[i]=(double*)malloc(sizeof(double)*(maxiter+1)));
+    check_alloc(lcount[i]=(long*)malloc(sizeof(long)*(maxiter+1)));
+  }
+  check_alloc(dx=(double*)malloc(sizeof(double)*(maxiter+1)));
+
+  for (i=0;i<=maxiter;i++)
+    for (j=0;j<maxdim-1;j++) {
+      lfactor[j][i]=0.0;
+      lcount[j][i]=0;
+    }
+  
+  for (j=mindim-2;j<maxdim-1;j++) {
+    for (k=0;k<found[j];k++) {
+      element=lfound[j][k];
+      for (i=0;i<=maxiter;i++)
+	dx[i]=sqr(series[act+i]-series[element+i]);
+      for (l=1;l<j+2;l++) {
+	l1=l*delay;
+	for (i=0;i<=maxiter;i++)
+	  dx[i] += sqr(series[act+i+l1]-series[element+l1+i]);
+      }
+      for (i=0;i<=maxiter;i++)
+	if (dx[i] > 0.0){
+	  lcount[j][i]++;
+	  lfactor[j][i] += dx[i];
+	}
+    }
+  }
+  for (i=mindim-2;i<maxdim-1;i++)
+    for (j=0;j<=maxiter;j++)
+      if (lcount[i][j]) {
+	count[i][j]++;
+	lyap[i][j] += log(lfactor[i][j]/lcount[i][j])/2.0;
+      }
+  
+  for (i=0;i<maxdim-1;i++){
+    free(lfactor[i]);
+    free(lcount[i]);
+  }
+  free(lcount);
+  free(lfactor);
+  free(dx);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  double eps_fak;
+  double epsilon;
+  unsigned int i,j,l;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+6,1));
+      sprintf(outfile,"%s.lyap",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc(11,1));
+      sprintf(outfile,"stdin.lyap");
+    }
+  }
+  test_outfile(outfile);
+
+  series=get_series(infile,&length,exclude,column,verbosity);
+  rescale_data(series,length,&min,&max);
+
+  if (eps0set)
+    epsmin /= max;
+  if (eps1set)
+    epsmax /= max;
+
+  if (epsmin >= epsmax) {
+    epsmax=epsmin;
+    epscount=1;
+  }
+  
+  if (reference > (length-maxiter-(maxdim-1)*delay))
+    reference=length-maxiter-(maxdim-1)*delay;
+  if ((maxiter+(maxdim-1)*delay) >= length) {
+    fprintf(stderr,"Too few points to handle these parameters!\n");
+    exit(LYAP_K__MAXITER_TOO_LARGE);
+  }
+
+  if (maxdim < 2)
+    maxdim=2;
+  if (mindim < 2)
+    mindim=2;
+  if (mindim > maxdim)
+    maxdim=mindim;
+  
+  check_alloc(liste=(long*)malloc(sizeof(long)*(length)));
+  check_alloc(found=(long*)malloc(sizeof(long)*(maxdim-1)));
+  check_alloc(lfound=(long**)malloc(sizeof(long*)*(maxdim-1)));
+  for (i=0;i<maxdim-1;i++)
+    check_alloc(lfound[i]=(long*)malloc(sizeof(long)*(length)));
+  check_alloc(count=(long**)malloc(sizeof(long*)*(maxdim-1)));
+  for (i=0;i<maxdim-1;i++)
+    check_alloc(count[i]=(long*)malloc(sizeof(long)*(maxiter+1)));
+  check_alloc(lyap=(double**)malloc(sizeof(double*)*(maxdim-1)));
+  for (i=0;i<maxdim-1;i++)
+    check_alloc(lyap[i]=(double*)malloc(sizeof(double)*(maxiter+1)));
+
+  if (epscount == 1)
+    eps_fak=1.0;
+  else
+    eps_fak=pow(epsmax/epsmin,1.0/(double)(epscount-1));
+
+  fout=fopen(outfile,"w");
+  if (verbosity&VER_INPUT)
+    fprintf(stderr,"Opened %s for writing\n",outfile);
+  for (l=0;l<epscount;l++) {
+    epsilon=epsmin*pow(eps_fak,(double)l);
+    for (i=0;i<maxdim-1;i++)
+      for (j=0;j<=maxiter;j++) {
+	count[i][j]=0;
+	lyap[i][j]=0.0;
+      }
+    put_in_boxes(epsilon);
+    for (i=0;i<reference;i++) {
+      lfind_neighbors(i,epsilon);
+      iterate_points(i);
+    }
+    if (verbosity&VER_USR1)
+      fprintf(stderr,"epsilon= %e\n",epsilon*max);
+    for (i=mindim-2;i<maxdim-1;i++) {
+      fprintf(fout,"#epsilon= %e  dim= %d\n",epsilon*max,i+2);
+      for (j=0;j<=maxiter;j++)
+	if (count[i][j])
+	  fprintf(fout,"%d %e %ld\n",j,lyap[i][j]/count[i][j],count[i][j]);
+      fprintf(fout,"\n");
+    }
+    fflush(fout);
+  }
+  fclose(fout);
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lyap_r.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lyap_r.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,251 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, last modified: Apr 25, 2002 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the maximal Lyapunov exponent; Rosenstein et al."
+
+#define NMAX 256
+
+char *outfile=NULL;
+char *infile=NULL;
+char epsset=0;
+double *series,*lyap;
+long box[NMAX][NMAX],*list;
+unsigned int dim=2,delay=1,steps=10,mindist=0;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+const unsigned int nmax=NMAX-1;
+unsigned long length=ULONG_MAX,exclude=0;
+long *found;
+double eps0=1.e-3,eps,epsinv;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of datapoints [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-c column to read[default 1]\n");
+  fprintf(stderr,"\t-m embedding dimension [default 2]\n");
+  fprintf(stderr,"\t-d delay  [default 1]\n");
+  fprintf(stderr,"\t-t time window to omit [default 0]\n");
+  fprintf(stderr,"\t-r epsilon size to start with [default "
+	  "(data interval)/1000]\n");
+  fprintf(stderr,"\t-s # of iterations [default 10]\n");
+  fprintf(stderr,"\t-o name of output file [default 'datafile'.ros]\n");
+  fprintf(stderr,"\t-V verbosity level [default 3]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+          "2='+ give more detailed information about the length scales\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(argv,n,'m','u')) != NULL)
+    sscanf(out,"%u",&dim);
+  if ((out=check_option(argv,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(argv,n,'t','u')) != NULL)
+    sscanf(out,"%u",&mindist);
+  if ((out=check_option(argv,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&eps0);
+  }
+  if ((out=check_option(argv,n,'s','u')) != NULL)
+    sscanf(out,"%u",&steps);
+  if ((out=check_option(argv,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,n,'o','o')) != NULL)
+    if (strlen(out) > 0)
+      outfile=out;
+}
+      
+void put_in_boxes(void)
+{
+  int i,j,x,y,del;
+  
+  for (i=0;i<NMAX;i++)
+    for (j=0;j<NMAX;j++)
+      box[i][j]= -1;
+
+  del=delay*(dim-1);
+  for (i=0;i<length-del-steps;i++) {
+    x=(int)(series[i]*epsinv)&nmax;
+    y=(int)(series[i+del]*epsinv)&nmax;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
+char make_iterate(long act)
+{
+  char ok=0;
+  int x,y,i,j,i1,k,del1=dim*delay;
+  long element,minelement= -1;
+  double dx,mindx=1.0;
+
+  x=(int)(series[act]*epsinv)&nmax;
+  y=(int)(series[act+delay*(dim-1)]*epsinv)&nmax;
+  for (i=x-1;i<=x+1;i++) {
+    i1=i&nmax;
+    for (j=y-1;j<=y+1;j++) {
+      element=box[i1][j&nmax];
+      while (element != -1) {
+	if (labs(act-element) > mindist) {
+	  dx=0.0;
+	  for (k=0;k<del1;k+=delay) {
+	    dx += (series[act+k]-series[element+k])*
+	      (series[act+k]-series[element+k]);
+	    if (dx > eps*eps)
+	      break;
+	  }
+	  if (k==del1) {
+	    if (dx < mindx) {
+	      ok=1;
+	      if (dx > 0.0) {
+		mindx=dx;
+		minelement=element;
+	      }
+	    }
+	  }
+	}
+	element=list[element];
+      }
+    }
+  }
+  if ((minelement != -1) ) {
+    act--;
+    minelement--;
+    for (i=0;i<=steps;i++) {
+      act++;
+      minelement++;
+      dx=0.0;
+      for (j=0;j<del1;j+=delay) {
+	dx += (series[act+j]-series[minelement+j])*
+	  (series[act+j]-series[minelement+j]);
+      }
+      if (dx > 0.0) {
+	found[i]++;
+	lyap[i] += log(dx);
+      }
+    }
+  }
+  return ok;
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0,*done,alldone;
+  int i;
+  long n;
+  long maxlength;
+  double min,max;
+  FILE *file;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".ros");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.ros");
+    }
+  }
+  test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  rescale_data(series,length,&min,&max);
+
+  if (epsset)
+    eps0 /= max;
+
+  check_alloc(list=(long*)malloc(length*sizeof(long)));
+  check_alloc(lyap=(double*)malloc((steps+1)*sizeof(double)));
+  check_alloc(found=(long*)malloc((steps+1)*sizeof(long)));
+  check_alloc(done=(char*)malloc(length));
+
+  for (i=0;i<=steps;i++) {
+    lyap[i]=0.0;
+    found[i]=0;
+  }
+  for (i=0;i<length;i++)
+    done[i]=0;
+  
+  maxlength=length-delay*(dim-1)-steps-1-mindist;
+  alldone=0;
+  file=fopen(outfile,"w");
+  if (verbosity&VER_INPUT)
+    fprintf(stderr,"Opened %s for writing\n",outfile);
+  for (eps=eps0;!alldone;eps*=1.1) {
+    epsinv=1.0/eps;
+    put_in_boxes();
+    alldone=1;
+    for (n=0;n<=maxlength;n++) {
+      if (!done[n])
+	done[n]=make_iterate(n);
+      alldone &= done[n];
+    }
+    if (verbosity&VER_USR1)
+      fprintf(stderr,"epsilon: %e already found: %ld\n",eps*max,found[0]);
+  } 
+  for (i=0;i<=steps;i++)
+    if (found[i])
+      fprintf(file,"%d %e\n",i,lyap[i]/found[i]/2.0);
+  fclose(file);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lyap_spec.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lyap_spec.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,574 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, last modified Dec 4, 2005  */
+/*Changes:
+  7/14/05: Changed borders of the sort routine to speed things up
+  11/25/05: Show also absolute forecast errors
+  12/04/05: Some more changes in sort
+  12/20/05: Change in increase neighborhood size loop
+  12/28/05: Found bug in memory allocation (index)
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <time.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the spectrum of Lyapunov exponents using the\n\t\
+method of Sano and Sawada."
+
+#define OUT 10
+
+#define BOX 512
+#define EPSMAX 1.0
+#define DELAY 1
+
+char epsset=0,stdo=1;
+char INVERSE,*outfile=NULL;
+char *infile=NULL;
+char dimset=0;
+char *COLUMNS=NULL;
+unsigned long LENGTH=ULONG_MAX,ITERATIONS,exclude=0;
+unsigned int EMBED=2,DIMENSION=1/*,DELAY=1*/,MINNEIGHBORS=30;
+unsigned int verbosity=0xff;
+double EPSSTEP=1.2;
+
+double **series,*averr,avneig=0.0,aveps=0.0;
+double **mat,*vec,*abstand;
+double epsmin;
+long imax=BOX-1,count=0;
+long **box,*list;
+unsigned long *found;
+unsigned int alldim,**indexes;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of datapoints [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-c column to read[default 1]\n");
+  fprintf(stderr,"\t-m # of components,embedding dimension [default %d,%d]\n",
+	  DIMENSION,EMBED);
+  //  fprintf(stderr,"\t-d delay  [default %d]\n",DELAY);
+  fprintf(stderr,"\t-r epsilon size to start with [default "
+  "(data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase epsilon [default: 1.2]\n");
+  fprintf(stderr,"\t-k # of neighbors to use [default: 30]\n");
+  fprintf(stderr,"\t-n # of iterations [default: length]\n");
+  fprintf(stderr,"\t-I invert the time series [default: no]\n");
+  fprintf(stderr,"\t-o name of output file [default 'datafile'.lyaps]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char **argv)
+{
+  char *out;
+  
+  if ((out=check_option(argv,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(argv,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,n,'c','s')) != NULL)
+    COLUMNS=out;
+  /*  if ((out=check_option(argv,n,'d','u')) != NULL)
+      sscanf(out,"%u",&DELAY);*/
+  if ((out=check_option(argv,n,'m','2')) != NULL) {
+    sscanf(out,"%u,%u",&DIMENSION,&EMBED);
+    dimset=1;
+  }
+  if ((out=check_option(argv,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&ITERATIONS);
+  if ((out=check_option(argv,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&epsmin);
+  }
+  if ((out=check_option(argv,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSSTEP);
+  if ((out=check_option(argv,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINNEIGHBORS);
+  if ((out=check_option(argv,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,n,'I','n')) != NULL)
+    INVERSE=1;
+  if ((out=check_option(argv,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double sort(long act,unsigned long* nfound,char *enough)
+{
+  double maxeps=0.0,dx,dswap,maxdx;
+  long self=0,i,j,del,hf,iswap,n1;
+  unsigned long imax=*nfound;
+
+  *enough=0;
+
+  for (i=0;i<imax;i++) {
+    hf=found[i];
+    if (hf != act) {
+      maxdx=fabs(series[0][act]-series[0][hf]);
+      for (j=1;j<alldim;j++) {
+	n1=indexes[0][j];
+	del=indexes[1][j];
+	dx=fabs(series[n1][act-del]-series[n1][hf-del]);
+	if (dx > maxdx) maxdx=dx;
+      }
+      abstand[i]=maxdx;
+    }
+    else {
+      self=i;
+    }
+  }
+
+  if (self != (imax-1)) {
+    abstand[self]=abstand[imax-1];
+    found[self]=found[imax-1];
+  }
+
+  for (i=0;i<MINNEIGHBORS;i++) {
+    for (j=i+1;j<imax-1;j++) {
+      if (abstand[j]<abstand[i]) {
+	dswap=abstand[i];
+	abstand[i]=abstand[j];
+	abstand[j]=dswap;
+	iswap=found[i];
+	found[i]=found[j];
+	found[j]=iswap;
+      }
+    }
+  }
+
+  if (!epsset || (abstand[MINNEIGHBORS-1] >= epsmin)) {
+    *nfound=MINNEIGHBORS;
+    *enough=1;
+    maxeps=abstand[MINNEIGHBORS-1];
+
+    return maxeps;
+  }
+
+  for (i=MINNEIGHBORS;i<imax-2;i++) {
+    for (j=i+1;j<imax-1;j++) {
+      if (abstand[j]<abstand[i]) {
+	dswap=abstand[i];
+	abstand[i]=abstand[j];
+	abstand[j]=dswap;
+	iswap=found[i];
+	found[i]=found[j];
+	found[j]=iswap;
+      }
+    }
+    if (abstand[i] > epsmin) {
+      (*nfound)=i+1;
+      *enough=1;
+      maxeps=abstand[i];
+
+      return maxeps;
+    }
+  }
+
+  maxeps=abstand[imax-2];
+
+  return maxeps;
+}
+
+void make_dynamics(double **dynamics,long act)
+{
+  long i,hi,j,hj,k,t=act,d;
+  unsigned long nfound=0;
+  double **hser,**imat;
+  double foundeps=0.0,epsilon,hv,hv1;
+  double new_vec;
+  char got_enough;
+
+  check_alloc(hser=(double**)malloc(sizeof(double*)*DIMENSION));
+  for (i=0;i<DIMENSION;i++)
+    hser[i]=series[i]+act;
+
+  epsilon=epsmin/EPSSTEP;
+  do {
+    epsilon *= EPSSTEP;
+    if (epsilon > EPSMAX)
+      epsilon=EPSMAX;
+    make_multi_box(series,box,list,LENGTH-DELAY,BOX,DIMENSION,EMBED,
+		   DELAY,epsilon);
+    nfound=find_multi_neighbors(series,box,list,hser,LENGTH-DELAY,BOX,
+				DIMENSION,EMBED,DELAY,epsilon,found);
+    if (nfound > MINNEIGHBORS) {
+      foundeps=sort(act,&nfound,&got_enough);
+      if (got_enough)
+	break;
+    }
+  } while (epsilon < EPSMAX);
+
+  free(hser);
+
+  avneig += nfound;
+  aveps += foundeps;
+  if (!epsset)
+    epsmin=aveps/count;
+  if (nfound < MINNEIGHBORS) {
+    fprintf(stderr,"#Not enough neighbors found. Exiting\n");
+    exit(LYAP_SPEC_NOT_ENOUGH_NEIGHBORS);
+  }
+  
+  for (i=0;i<=alldim;i++) {
+    vec[i]=0.0;
+    for (j=0;j<=alldim;j++) 
+      mat[i][j]=0.0;
+  }
+  
+  for (i=0;i<nfound;i++) {
+    act=found[i];
+    mat[0][0] += 1.0;
+    for (j=0;j<alldim;j++)
+      mat[0][j+1] += series[indexes[0][j]][act-indexes[1][j]];
+    for (j=0;j<alldim;j++) {
+      hv1=series[indexes[0][j]][act-indexes[1][j]];
+      hj=j+1;
+      for (k=j;k<alldim;k++)
+	mat[hj][k+1] += series[indexes[0][k]][act-indexes[1][k]]*hv1;
+    }
+  }
+
+  for (i=0;i<=alldim;i++)
+    for (j=i;j<=alldim;j++)
+      mat[j][i]=(mat[i][j]/=(double)nfound);
+  
+  imat=invert_matrix(mat,alldim+1);
+  
+  for (d=0;d<DIMENSION;d++) {
+    for (i=0;i<=alldim;i++)
+      vec[i]=0.0;
+    for (i=0;i<nfound;i++) {
+      act=found[i];
+      hv=series[d][act+DELAY];
+      vec[0] += hv;
+      for (j=0;j<alldim;j++)
+	vec[j+1] += hv*series[indexes[0][j]][act-indexes[1][j]];
+    }
+    for (i=0;i<=alldim;i++)
+      vec[i] /= (double)nfound;
+    
+    new_vec=0.0;
+    for (i=0;i<=alldim;i++)
+      new_vec += imat[0][i]*vec[i];
+    for (i=1;i<=alldim;i++) {
+      hi=i-1;
+      dynamics[d][hi]=0.0;
+      for (j=0;j<=alldim;j++)
+	dynamics[d][hi] += imat[i][j]*vec[j];
+    }
+    for (i=0;i<alldim;i++)
+      new_vec += dynamics[d][i]*series[indexes[0][i]][t-indexes[1][i]];
+    averr[d] += (new_vec-series[d][t+DELAY])*(new_vec-series[d][t+DELAY]);
+  }
+
+  for (i=0;i<=alldim;i++)
+    free(imat[i]);
+  free(imat);
+}
+
+void gram_schmidt(double **delta,
+		  double *stretch)
+{
+  double **dnew,norm,*diff;
+  long i,j,k;
+  
+  check_alloc(diff=(double*)malloc(sizeof(double)*alldim));
+  check_alloc(dnew=(double**)malloc(sizeof(double*)*alldim));
+  for (i=0;i<alldim;i++)
+    check_alloc(dnew[i]=(double*)malloc(sizeof(double)*alldim));
+
+  for (i=0;i<alldim;i++) {
+    for (j=0;j<alldim;j++) 
+      diff[j]=0.0;
+    for (j=0;j<i;j++) {
+      norm=0.0;
+      for (k=0;k<alldim;k++)
+	norm += delta[i][k]*dnew[j][k];
+      for (k=0;k<alldim;k++)
+	diff[k] -= norm*dnew[j][k];
+    }
+    norm=0.0;
+    for (j=0;j<alldim;j++)
+      norm += sqr(delta[i][j]+diff[j]);
+    stretch[i]=(norm=sqrt(norm));
+    for (j=0;j<alldim;j++)
+      dnew[i][j]=(delta[i][j]+diff[j])/norm;
+  }
+  for (i=0;i<alldim;i++)
+    for (j=0;j<alldim;j++)
+      delta[i][j]=dnew[i][j];
+
+  free(diff);
+  for (i=0;i<alldim;i++)
+    free(dnew[i]);
+  free(dnew);
+}
+
+void make_iteration(double **dynamics,
+		    double **delta)
+{
+  double **dnew;
+  long i,j,k;
+
+  check_alloc(dnew=(double**)malloc(sizeof(double*)*alldim));
+  for (i=0;i<alldim;i++)
+    check_alloc(dnew[i]=(double*)malloc(sizeof(double)*alldim));
+
+  for (i=0;i<alldim;i++) {
+    for (j=0;j<DIMENSION;j++) {
+      dnew[i][j]=dynamics[j][0]*delta[i][0];
+      for (k=1;k<alldim;k++)
+	dnew[i][j] += dynamics[j][k]*delta[i][k];
+    }
+    for (j=DIMENSION;j<alldim;j++)
+      dnew[i][j]=delta[i][j-1];
+  }
+
+  for (i=0;i<alldim;i++)
+    for (j=0;j<alldim;j++)
+      delta[i][j]=dnew[i][j];
+
+  for (i=0;i<alldim;i++)
+    free(dnew[i]);
+  free(dnew);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  double **delta,**dynamics,*lfactor;
+  double *factor,dim;
+  double *hseries;
+  double *interval,*min,*av,*var,maxinterval;
+  long start,i,j;
+  time_t lasttime,newtime;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  ITERATIONS=ULONG_MAX;
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+7,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".lyaps");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)12,(size_t)1));
+      strcpy(outfile,"stdin.lyaps");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  alldim=DIMENSION*EMBED;
+
+  if (COLUMNS == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&DIMENSION,"",
+				      dimset,verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&DIMENSION,
+				      COLUMNS,dimset,verbosity);
+
+  if (MINNEIGHBORS > (LENGTH-DELAY*(EMBED-1)-1)) {
+    fprintf(stderr,"Your time series is not long enough to find %d neighbors!"
+	    " Exiting.\n",MINNEIGHBORS);
+    exit(LYAP_SPEC_DATA_TOO_SHORT);
+  }
+
+  check_alloc(min=(double*)malloc(sizeof(double)*DIMENSION));
+  check_alloc(interval=(double*)malloc(sizeof(double)*DIMENSION));
+  check_alloc(av=(double*)malloc(sizeof(double)*DIMENSION));
+  check_alloc(var=(double*)malloc(sizeof(double)*DIMENSION));
+  check_alloc(averr=(double*)malloc(sizeof(double)*DIMENSION));
+  maxinterval=0.0;
+  for (i=0;i<DIMENSION;i++) {
+    averr[i]=0.0;
+    rescale_data(series[i],LENGTH,&min[i],&interval[i]);
+    if (interval[i] > maxinterval) 
+      maxinterval=interval[i];
+    variance(series[i],LENGTH,&av[i],&var[i]);
+  }
+  
+  if (INVERSE) {
+    check_alloc(hseries=(double*)malloc(sizeof(double)*LENGTH));
+    for (j=0;j<DIMENSION;j++) {
+      for (i=0;i<LENGTH;i++)
+	hseries[LENGTH-1-i]=series[j][i];
+      for (i=0;i<LENGTH;i++)
+	series[j][i]=hseries[i];
+    }
+    free(hseries);
+  }
+  
+  if (!epsset)
+    epsmin=1./1000.;
+  else
+    epsmin /= maxinterval;
+  
+  check_alloc(box=(long**)malloc(sizeof(long*)*BOX));
+  for (i=0;i<BOX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*BOX));
+
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+
+  check_alloc(dynamics=(double**)malloc(sizeof(double*)*DIMENSION));
+  for (i=0;i<DIMENSION;i++)
+    check_alloc(dynamics[i]=(double*)malloc(sizeof(double)*alldim));
+  check_alloc(factor=(double*)malloc(sizeof(double)*alldim));
+  check_alloc(lfactor=(double*)malloc(sizeof(double)*alldim));
+  check_alloc(delta=(double**)malloc(sizeof(double*)*alldim));
+  for (i=0;i<alldim;i++)
+    check_alloc(delta[i]=(double*)malloc(sizeof(double)*alldim));
+  
+  check_alloc(vec=(double*)malloc(sizeof(double)*(alldim+1)));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*(alldim+1)));
+  for (i=0;i<=alldim;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*(alldim+1)));
+  
+  indexes=(unsigned int**)make_multi_index(DIMENSION,EMBED,DELAY);
+
+  rnd_init(0x098342L);
+  for (i=0;i<10000;i++)
+    rnd_long();
+  for (i=0;i<alldim;i++) {
+    factor[i]=0.0;
+    for (j=0;j<alldim;j++)
+      delta[i][j]=(double)rnd_long()/(double)ULONG_MAX;
+  }
+  gram_schmidt(delta,lfactor);
+  
+  start=ITERATIONS;
+  if (start>(LENGTH-DELAY)) 
+    start=LENGTH-DELAY;
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  check_alloc(abstand=(double*)malloc(sizeof(double)*LENGTH));
+
+  time(&lasttime);
+  for (i=(EMBED-1)*DELAY;i<start;i++) {
+    count++;
+    make_dynamics(dynamics,i);
+    make_iteration(dynamics,delta);
+    gram_schmidt(delta,lfactor);
+    for (j=0;j<alldim;j++) {
+      factor[j] += log(lfactor[j])/(double)DELAY;
+    }
+    if (((time(&newtime)-lasttime) > OUT) || (i == (start-1))) {
+      time(&lasttime);
+      if (!stdo) {
+	fprintf(file,"%ld ",count);
+	for (j=0;j<alldim;j++) 
+	  fprintf(file,"%e ",factor[j]/count);
+	fprintf(file,"\n");
+	fflush(file);
+      }
+      else {
+	fprintf(stdout,"%ld ",count);
+	for (j=0;j<alldim;j++) 
+	  fprintf(stdout,"%e ",factor[j]/count);
+	fprintf(stdout,"\n");
+      }
+    }
+  }
+  
+  dim=0.0;
+  for (i=0;i<alldim;i++) {
+    dim += factor[i];
+    if (dim < 0.0)
+      break;
+  }
+  if (i < alldim)
+    dim=i+(dim-factor[i])/fabs(factor[i]);
+  else
+    dim=alldim;
+  if (!stdo) {
+    fprintf(file,"#Average relative forecast errors:= ");
+    for (i=0;i<DIMENSION;i++)
+      fprintf(file,"%e ",sqrt(averr[i]/count)/var[i]);
+    fprintf(file,"\n");
+    fprintf(file,"#Average absolute forecast errors:= ");
+    for (i=0;i<DIMENSION;i++)
+      fprintf(file,"%e ",sqrt(averr[i]/count)*interval[i]);
+    fprintf(file,"\n");
+    fprintf(file,"#Average Neighborhood Size= %e\n",aveps*maxinterval/count);
+    fprintf(file,"#Average num. of neighbors= %e\n",avneig/count);
+    fprintf(file,"#estimated KY-Dimension= %f\n",dim);
+  }
+  else {
+    fprintf(stdout,"#Average relative forecast errors:= ");
+    for (i=0;i<DIMENSION;i++)
+      fprintf(stdout,"%e ",sqrt(averr[i]/count)/var[i]);
+    fprintf(stdout,"\n");
+    fprintf(stdout,"#Average absolute forecast errors:= ");
+    for (i=0;i<DIMENSION;i++)
+      fprintf(stdout,"%e ",sqrt(averr[i]/count)*interval[i]);
+    fprintf(stdout,"\n");
+    fprintf(stdout,"#Average Neighborhood Size= %e\n",aveps*maxinterval/count);
+    fprintf(stdout,"#Average num. of neighbors= %e\n",avneig/count);
+    fprintf(stdout,"#estimated KY-Dimension= %f\n",dim);
+  }
+  if (!stdo)
+    fclose(file);
+
+  free(abstand);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lzo-gm.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lzo-gm.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,293 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 7, 2004 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+#include <math.h>
+
+#define WID_STR "Estimates the average forecast error for a local\n\t\
+constant fit as a function of the neighborhood size."
+
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 256
+
+unsigned int nmax=(NMAX-1);
+long **box,*list;
+unsigned long *found;
+double *error;
+double **series;
+
+char eps0set=0,eps1set=0,causalset=0,dimset=0;
+char *outfile=NULL,stdo=1;
+char *column=NULL;
+unsigned int dim=1,embed=2,delay=1;
+unsigned int verbosity=0xff;
+int STEP=1;
+double EPS0=1.e-3,EPS1=1.0,EPSF=1.2;
+unsigned long LENGTH=ULONG_MAX,exclude=0,CLENGTH=ULONG_MAX,causal;
+char *infile=NULL;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1,...,# of components]\n");
+  fprintf(stderr,"\t-m # of components,embedding dimension [default: 1,2]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-i iterations [default: length]\n");
+  fprintf(stderr,"\t-r neighborhood size to start with [default:"
+	  " (interval of data)/1000)]\n");
+  fprintf(stderr,"\t-R neighborhood size to end with [default:"
+	  " interval of data]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-C width of causality window [default: steps]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile.lm']\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&dim,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'i','u')) != NULL)
+    sscanf(out,"%lu",&CLENGTH);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    eps0set=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'R','f')) != NULL) {
+    eps1set=1;
+    sscanf(out,"%lf",&EPS1);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'C','u')) != NULL) {
+    sscanf(out,"%lu",&causal);
+    causalset=1;
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void make_fit(long act,unsigned long number)
+{
+  double *si,cast;
+  long i,j;
+  
+  for (i=0;i<dim;i++) {
+    si=series[i];
+    cast=si[found[0]+STEP];
+    for (j=1;j<number;j++)
+      cast += si[found[j]+STEP];
+    cast /= (double)number;
+    error[i] += sqr(cast-series[i][act+STEP]);
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  unsigned long actfound;
+  unsigned long *hfound;
+  long pfound,i,j;
+  unsigned long clength;
+  double interval,min,maxinterval;
+  double epsilon;
+  double **hser;
+  double avfound,*hrms,*hav,sumerror=0.0;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  if (!causalset)
+    causal=STEP;
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+      sprintf(outfile,"%s.lm",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)9,(size_t)1));
+      sprintf(outfile,"stdin.lm");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,column,
+				      dimset,verbosity);
+  maxinterval=0.0;
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],LENGTH,&min,&interval);
+    if (interval > maxinterval)
+      maxinterval=interval;
+  }
+  interval=maxinterval;
+
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(hfound=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+  check_alloc(error=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hrms=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hav=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hser=(double**)malloc(sizeof(double*)*dim));
+  
+  if (eps0set)
+    EPS0 /= interval;
+  if (eps1set)
+    EPS1 /= interval;
+
+  clength=(CLENGTH <= LENGTH) ? CLENGTH-STEP : LENGTH-STEP;
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(file,"#1. size 2. relative forecast error 3. fraction of points\n"
+	    "#4. av neighbors found 5. absolute variance of the points\n");
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  for (epsilon=EPS0;epsilon<EPS1*EPSF;epsilon*=EPSF) {
+    pfound=0;
+    for (i=0;i<dim;i++)
+      error[i]=hrms[i]=hav[i]=0.0;
+    avfound=0.0;
+    make_multi_box(series,box,list,LENGTH-STEP,NMAX,dim,
+		   embed,delay,epsilon);
+    for (i=(embed-1)*delay;i<clength;i++) {
+      for (j=0;j<dim;j++)
+	hser[j]=series[j]+i;
+      actfound=find_multi_neighbors(series,box,list,hser,LENGTH,
+				    NMAX,dim,embed,delay,epsilon,hfound);
+      actfound=exclude_interval(actfound,i-causal+1,i+causal+(embed-1)*delay-1,
+				hfound,found);
+      if (actfound > 2*(dim*embed+1)) {
+	make_fit(i,actfound);
+	pfound++;
+	avfound += (double)(actfound-1);
+	for (j=0;j<dim;j++) {
+	  hrms[j] += series[j][i+STEP]*series[j][i+STEP];
+	  hav[j] += series[j][i+STEP];
+	}
+      }
+    }
+    if (pfound > 1) {
+      sumerror=0.0;
+      for (j=0;j<dim;j++) {
+	hav[j] /= pfound;
+	hrms[j]=sqrt(fabs(hrms[j]/(pfound-1)-hav[j]*hav[j]*pfound/(pfound-1)));
+	error[j]=sqrt(error[j]/pfound)/hrms[j];
+	sumerror += error[j];
+      }
+    }
+    if (stdo) {
+      if (pfound > 1) {
+	fprintf(stdout,"%e %e ",epsilon*interval,sumerror/(double)dim);
+	for (j=0;j<dim;j++)
+	  fprintf(stdout,"%e ",error[j]);
+	fprintf(stdout,"%e %e\n",(double)pfound/(clength-(embed-1)*delay),
+		avfound/pfound);
+	fflush(stdout);
+      }
+    }
+    else {
+      if (pfound > 1) {
+	fprintf(file,"%e %e ",epsilon*interval,sumerror/(double)dim);
+	for (j=0;j<dim;j++)
+	  fprintf(file,"%e ",error[j]);
+	fprintf(file,"%e %e\n",(double)pfound/(clength-(embed-1)*delay),
+		avfound/pfound);
+	fflush(file);
+      }
+    }
+  }
+  if (!stdo)
+    fclose(file);
+
+  free(list);
+  free(hfound);
+  free(error);
+  free(hrms);
+  free(hav);
+  free(hser);
+  for (i=0;i<NMAX;i++)
+    free(box[i]);
+  free(box);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lzo-run.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lzo-run.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,411 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Feb 19, 2007 */
+/* Changes:
+     2/19/2007:  Changed name and default for noise  
+     10/26/2006: Add seed option
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <time.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Makes a local zeroth order forecast for multivariate data\n\
+and iterates a trajectory"
+
+#define NMAX 128
+
+char onscreen=1,epsset=0,*outfile=NULL,setsort=1,setnoise=0;
+char *infile=NULL;
+unsigned int nmax=(NMAX-1);
+unsigned int verbosity=0xff;
+long **box,*list,*found;
+double **series,**cast,*abstand,*var;
+double epsilon;
+
+unsigned int embed=2,dim=1,dim1,DELAY=1;
+char *column=NULL,dimset=0;
+unsigned int MINN=50;
+unsigned int **indexes;
+unsigned long LENGTH=ULONG_MAX,FLENGTH=1000,exclude=0;
+unsigned long seed=0x9074325L;
+double EPS0=1.e-3,EPSF=1.2,Q=10.0;
+
+double **mat,*vec,*hsum,*newav;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to be used [default whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default 0]\n");
+  fprintf(stderr,"\t-c column [default 1,...,# of components]\n");
+  fprintf(stderr,"\t-m #of components,embedding dimension [default 1,2]\n");
+  fprintf(stderr,"\t-d delay for the embedding [default 1]\n");
+  fprintf(stderr,"\t-L # of iterations [default 1000]\n");
+  fprintf(stderr,"\t-k # of neighbors  [default %u]\n",MINN);
+  fprintf(stderr,"\t-K fix # of neighbors  [default no]\n");
+  fprintf(stderr,"\t-%% # variance of noise [default %3.1lf]\n",Q);
+  fprintf(stderr,"\t-I seed for the rnd-generator (If seed=0, the time\n"
+          "\t\tcommand is used to set the seed) [Default: fixed]\n");
+  fprintf(stderr,"\t-r size of initial neighborhood ["
+	  " default (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default 1.2]\n");
+  fprintf(stderr,"\t-o output file [default 'datafile'.lzr;"
+	  " no -o means write to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h  show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&dim,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'L','u')) != NULL)
+    sscanf(out,"%lu",&FLENGTH);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'K','n')) != NULL)
+    setsort=1;
+  if ((out=check_option(in,n,'I','u')) != NULL) {
+    sscanf(out,"%lu",&seed);
+    if (seed == 0)
+      seed=(unsigned long)time((time_t*)&seed);
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'%','f')) != NULL) {
+    sscanf(out,"%lf",&Q);
+    if (Q>0.0)
+      setnoise=1;
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    onscreen=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void sort(unsigned long nfound)
+{
+  double dx,dswap;
+  int i,j,k,hf,iswap,hdim;
+
+  hdim=(embed-1)*DELAY;
+
+  for (i=0;i<nfound;i++) {
+    hf=found[i];
+    abstand[i]=0.0;
+    for (j=0;j<dim;j++) {
+      for (k=0;k<=hdim;k += DELAY) {
+	dx=fabs(series[j][hf-k]-cast[hdim-k][j]);
+	if (dx > abstand[i]) abstand[i]=dx;
+      }
+    }
+  }
+
+  for (i=0;i<MINN;i++)
+    for (j=i+1;j<nfound;j++)
+      if (abstand[j]<abstand[i]) {
+	dswap=abstand[i];
+	abstand[i]=abstand[j];
+	abstand[j]=dswap;
+	iswap=found[i];
+	found[i]=found[j];
+	found[j]=iswap;
+      }
+}
+
+void put_in_boxes(void)
+{
+  int i,j,n;
+  static int hdim;
+  double epsinv;
+
+  hdim=(embed-1)*DELAY;
+  epsinv=1.0/epsilon;
+  for (i=0;i<NMAX;i++)
+    for (j=0;j<NMAX;j++)
+      box[i][j]= -1;
+
+  for (n=hdim;n<LENGTH-1;n++) {
+    i=(int)(series[0][n]*epsinv)&nmax;
+    j=(int)(series[dim1][n-hdim]*epsinv)&nmax;
+    list[n]=box[i][j];
+    box[i][j]=n;
+  }
+}
+
+unsigned int hfind_neighbors(void)
+{
+  char toolarge;
+  int i,j,i1,i2,j1,l,hc,hd,element;
+  static int hdim;
+  unsigned nfound=0;
+  double max,dx,epsinv;
+
+  hdim=(embed-1)*DELAY;
+  epsinv=1.0/epsilon;
+  i=(int)(cast[hdim][0]*epsinv)&nmax;
+  j=(int)(cast[0][dim1]*epsinv)&nmax;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&nmax;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&nmax];
+      while (element != -1) {
+	max=0.0;
+	toolarge=0;
+	for (l=0;l<dim*embed;l++) {
+	  hc=indexes[0][l];
+	  hd=indexes[1][l];
+	  dx=fabs(series[hc][element-hd]-cast[hdim-hd][hc]);
+	  max=(dx>max) ? dx : max;
+	  if (max > epsilon) {
+	    toolarge=1;
+	    break;
+	  }
+	}
+	if (max <= epsilon)
+	  found[nfound++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nfound;
+}
+
+void make_zeroth(int number,double *newcast)
+{
+  long d,i;
+  double *sd;
+  
+  for (d=0;d<dim;d++) {
+    newcast[d]=0.0;
+    sd=series[d]+1;
+    for (i=0;i<number;i++)
+      newcast[d] += sd[found[i]];
+    newcast[d] /= (double)number;
+  }
+
+  if (setnoise) {
+    for (d=0;d<dim;d++)
+      newcast[d] += gaussian(var[d]*Q);
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0,done;
+  long i,j,hdim,actfound;
+  unsigned long count=1;
+  double *swap,*newcast,maxinterval,*min,*interval,dummy,epsilon0;
+  FILE *file=NULL;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+  
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".lzr");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.lzr");
+    }
+  }
+  if (!onscreen)
+    test_outfile(outfile);
+  
+  hdim=(embed-1)*DELAY+1;
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,column,
+				      dimset,verbosity);
+
+  dim1=dim-1;
+
+  check_alloc(min=(double*)malloc(sizeof(double)*dim));
+  check_alloc(interval=(double*)malloc(sizeof(double)*dim));
+  check_alloc(var=(double*)malloc(sizeof(double)*dim));
+
+  maxinterval=0.0;
+
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],LENGTH,&min[i],&interval[i]);
+    variance(series[i],LENGTH,&dummy,&var[i]);
+    if (interval[i] > maxinterval)
+      maxinterval=interval[i];
+  }
+
+  if (epsset)
+    EPS0 /= maxinterval;
+    
+  check_alloc(cast=(double**)malloc(sizeof(double*)*hdim));
+  for (i=0;i<hdim;i++)
+    check_alloc(cast[i]=(double*)malloc(sizeof(double)*dim));
+  check_alloc(newcast=(double*)malloc(sizeof(double)*dim));
+  check_alloc(newav=(double*)malloc(sizeof(double)*dim));
+    
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(abstand=(double*)malloc(sizeof(double)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+  
+  check_alloc(vec=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hsum=(double*)malloc(sizeof(double)*dim));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*dim));
+  for (i=0;i<dim;i++) {
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*dim));
+  }
+
+  for (j=0;j<dim;j++)
+    for (i=0;i<hdim;i++)
+      cast[i][j]=series[j][LENGTH-hdim+i];
+
+  indexes=make_multi_index(dim,embed,DELAY);
+  
+  if (!onscreen) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  rnd_init(seed);
+
+  epsilon0=EPS0/EPSF;
+
+  if (setnoise) 
+    Q /= 100.0;
+
+  for (i=0;i<FLENGTH;i++) {
+    done=0;
+    if (setsort)
+      epsilon= epsilon0/((double)count*EPSF);
+    else
+      epsilon=epsilon0;
+    while (!done) {
+      epsilon*=EPSF;
+      put_in_boxes();
+      actfound=hfind_neighbors();
+      if (actfound >= MINN) {
+	if (setsort) {
+	  epsilon0 += epsilon;
+	  count++;
+	  sort(actfound);
+	  actfound=MINN;
+	}
+	make_zeroth(actfound,newcast);
+	if (onscreen) {
+	  for (j=0;j<dim-1;j++)
+	    printf("%e ",newcast[j]*interval[j]+min[j]);
+	  printf("%e\n",newcast[dim-1]*interval[dim-1]+min[dim-1]);
+	  fflush(stdout);
+	}
+	else {
+	  for (j=0;j<dim-1;j++)
+	    fprintf(file,"%e ",newcast[j]*interval[j]+min[j]);
+	  fprintf(file,"%e\n",newcast[dim-1]*interval[dim-1]+min[dim-1]);
+	  fflush(file);
+	}
+	done=1;
+	swap=cast[0];
+	for (j=0;j<hdim-1;j++)
+	  cast[j]=cast[j+1];
+	cast[hdim-1]=swap;
+	for (j=0;j<dim;j++)
+	  cast[hdim-1][j]=newcast[j];
+      }
+    }
+  }
+  if (!onscreen)
+    fclose(file);
+  
+  if (outfile != NULL)
+    free(outfile);
+  for (i=0;i<dim;i++)
+    free(mat[i]);
+  free(mat);
+  for (i=0;i<hdim;i++)
+    free(cast[i]);
+  free(cast);
+  free(newcast);
+  free(found);
+  free(list);
+  for (i=0;i<NMAX;i++)
+    free(box[i]);
+  free(box);
+  free(vec);
+  free(newav);
+  for (i=0;i<dim;i++)
+    free(series[i]);
+  free(series);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/lzo-test.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/lzo-test.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,345 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Aug 27, 2004 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the average forecast error for a zeroth\n\t\
+order fit from a multidimensional time series"
+
+
+#ifndef _MATH_H
+#include <math.h>
+#endif
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 512
+
+unsigned int nmax=(NMAX-1);
+long **box,*list;
+unsigned long *found;
+double **series,**diffs;
+double interval,min,epsilon;
+
+char epsset=0,dimset=0,clengthset=0,causalset=0;
+char *infile=NULL;
+char *outfile=NULL,stdo=1;
+char *COLUMNS=NULL;
+unsigned int embed=2,dim=1,DELAY=1,MINN=30;
+unsigned long STEP=1,causal;
+unsigned int verbosity=0x1;
+double EPS0=1.e-3,EPSF=1.2;
+unsigned long refstep=1;
+unsigned long LENGTH=ULONG_MAX,exclude=0,CLENGTH=ULONG_MAX;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1,...,X]\n");
+  fprintf(stderr,"\t-m dimension and embedding dimension"
+	  " [default: %d,%d]\n",dim,embed);
+  fprintf(stderr,"\t-d delay [default: %d]\n",DELAY);
+  fprintf(stderr,"\t-n # of reference points [default: length]\n");
+  fprintf(stderr,"\t-S temporal distance between the reference points"
+	  " [default: %lu]\n",refstep);
+  fprintf(stderr,"\t-k minimal number of neighbors for the fit "
+	  "[default: %d]\n",MINN);
+  fprintf(stderr,"\t-r neighborhoud size to start with "
+	  "[default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-C width of causality window [default: steps]\n");
+  fprintf(stderr,"\t-o output file [default: 'datafile.zer',"
+	  " without -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+	  "2='give individual forecast errors for the max step'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    COLUMNS=out;
+  if ((out=check_option(in,n,'m','2')) != NULL) {
+    dimset=1;
+    sscanf(out,"%u%*c%u",&dim,&embed);
+    if (embed == 0)
+      embed=1;
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'n','u')) != NULL) {
+    sscanf(out,"%lu",&CLENGTH);
+    clengthset=1;
+  }
+  if ((out=check_option(in,n,'S','u')) != NULL)
+    sscanf(out,"%lu",&refstep);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%lu",&STEP);
+  if ((out=check_option(in,n,'C','u')) != NULL) {
+    sscanf(out,"%lu",&causal);
+    causalset=1;
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void make_fit(long act,unsigned long number,long istep,double **error)
+{
+  double casted,*help;
+  long i,j,h;
+  
+  h=istep-1;
+  for (j=0;j<dim;j++) {
+    casted=0.0;
+    help=series[j]+istep;
+    for (i=0;i<number;i++)
+      casted += help[found[i]];
+    casted /= number;
+    diffs[j][act]=casted-help[act];
+    error[j][h] += sqr(casted-help[act]);
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  char alldone,*done;
+  long i,j,hi;
+  unsigned long *hfound;
+  unsigned long actfound;
+  unsigned long clength;
+  double *rms,*av,**error,**hser,*hinter;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+
+  if ((2*STEP+causal) >= ((long)LENGTH-(long)(embed*DELAY)-(long)MINN)) {
+    fprintf(stderr,"steps to forecast (-s) too large. Exiting!\n");
+    exit(ZEROTH__STEP_TOO_LARGE);
+  }
+  if (!causalset)
+    causal=STEP;
+
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.zer",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.zer");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+  
+  if (COLUMNS == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&dim,COLUMNS,
+				      dimset,verbosity);
+
+  check_alloc(hser=(double**)malloc(sizeof(double*)*dim));
+  check_alloc(av=(double*)malloc(sizeof(double)*dim));
+  check_alloc(rms=(double*)malloc(sizeof(double)*dim));
+  check_alloc(hinter=(double*)malloc(sizeof(double)*dim));
+  interval=0.0;
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],LENGTH,&min,&hinter[i]);
+    variance(series[i],LENGTH,&av[i],&rms[i]);
+    interval += hinter[i];
+  }
+  interval /= (double)dim;
+
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(hfound=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(done=(char*)malloc(sizeof(char)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  check_alloc(error=(double**)malloc(sizeof(double*)*dim));
+  check_alloc(diffs=(double**)malloc(sizeof(double*)*dim));
+  for (j=0;j<dim;j++) {
+    check_alloc(diffs[j]=(double*)malloc(sizeof(double)*LENGTH));
+    check_alloc(error[j]=(double*)malloc(sizeof(double)*STEP));
+    for (i=0;i<STEP;i++)
+      error[j][i]=0.0;
+  }
+  
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+    
+  for (i=0;i<LENGTH;i++)
+    done[i]=0;
+
+  alldone=0;
+  if (epsset)
+    EPS0 /= interval;
+
+  epsilon=EPS0/EPSF;
+
+  if (!clengthset)
+    CLENGTH=LENGTH;
+  clength=((CLENGTH*refstep+STEP) <= LENGTH) ? CLENGTH : 
+    (LENGTH-(long)STEP)/refstep;
+
+  while (!alldone) {
+    alldone=1;
+    epsilon*=EPSF;
+    make_multi_box(series,box,list,LENGTH-(long)STEP,NMAX,(unsigned int)dim,
+		   (unsigned int)embed,(unsigned int)DELAY,epsilon);
+    for (i=(embed-1)*DELAY;i<clength;i++)
+      if (!done[i]) {
+	hi=i*refstep;
+	for (j=0;j<dim;j++)
+	  hser[j]=series[j]+hi;
+	actfound=find_multi_neighbors(series,box,list,hser,LENGTH,NMAX,
+				       (unsigned int)dim,(unsigned int)embed,
+				       (unsigned int)DELAY,epsilon,hfound);
+	actfound=exclude_interval(actfound,hi-(long)causal+1,
+				  hi+causal+(embed-1)*DELAY-1,hfound,found);	
+	if (actfound >= MINN) {
+	  for (j=1;j<=STEP;j++) {
+	    make_fit(hi,actfound,j,error);
+	  }
+	  done[i]=1;
+	}
+	alldone &= done[i];
+      }
+  }
+  if (stdo) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=0;i<STEP;i++) {
+      if (verbosity&VER_USR1)
+	fprintf(stdout,"# %lu ",i+1);
+      else
+	fprintf(stdout,"%lu ",i+1);
+      for (j=0;j<dim;j++) 
+	fprintf(stdout,"%e ",
+		sqrt(error[j][i]/(clength-(embed-1)*DELAY))/rms[j]);
+      fprintf(stdout,"\n");
+    }
+    if (verbosity&VER_USR1) {
+      for (i=(embed-1)*DELAY;i<clength;i++) {
+	hi=i*refstep;
+	for (j=0;j<dim;j++)
+	  fprintf(stdout,"%e ",diffs[j][hi]*hinter[j]);
+	fprintf(stdout,"\n");
+      }
+    }
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=0;i<STEP;i++) {
+      if (verbosity&VER_USR1)
+	fprintf(file,"# %lu ",i+1);
+      else
+	fprintf(file,"%lu ",i+1);
+      for (j=0;j<dim;j++) 
+	fprintf(file,"%e ",sqrt(error[j][i]/(clength-(embed-1)*DELAY))/rms[j]);
+      fprintf(file,"\n");
+    }
+    if (verbosity&VER_USR1) {
+      for (i=(embed-1)*DELAY;i<clength;i++) {
+	hi=i*refstep;
+	for (j=0;j<dim;j++)
+	  fprintf(file,"%e ",diffs[j][hi]*hinter[j]);
+	fprintf(file,"\n");
+      }
+    }
+    fclose(file);
+  }
+
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  if (COLUMNS != NULL)
+    free(COLUMNS);
+  for (i=0;i<dim;i++) {
+    free(series[i]);
+    free(diffs[i]);
+    free(error[i]);
+  }
+  free(series);
+  free(diffs);
+  free(hser);
+  free(error);
+  free(av);
+  free(rms);
+  free(list);
+  free(found);
+  free(hfound);
+  free(done);
+  for (i=0;i<NMAX;i++)
+    free(box[i]);
+  free(box);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/makenoise.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/makenoise.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,254 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 29, 2000 */
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <time.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Adds noise to a time series or just creates random numbers"
+
+char *outfile=NULL,cgaussian,stout=1,justcreate=0;
+char *infile=NULL;
+char absolute=0,dimset=0;
+unsigned long length=ULONG_MAX,exclude=0,iseed=3441341;
+unsigned int dim=1;
+char *column=NULL;
+unsigned int verbosity=0xff;
+double **array,noiselevel=0.05;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of points to be used [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default: %lu]\n",exclude);
+  fprintf(stderr,"\t-m # of columns to read [Default: %u]\n",dim);
+  fprintf(stderr,"\t-c column(s) to read  [Default: 1]\n");
+  fprintf(stderr,"\t-%% noiselevel in %% [Default:  %.1e%%]\n",
+	  noiselevel*100.0);
+  fprintf(stderr,"\t-r absolute noise level (or absolute variance in case\n"
+	  "\t\tof gaussian noise) [Default: not set]\n");
+  fprintf(stderr,"\t-g (use gaussian noise)     [Default: uniform]\n");
+  fprintf(stderr,"\t-I seed for the rnd-generator (If seed=0, the time\n"
+	  "\t\tcommand is used to set the seed) [Default: fixed]\n");
+  fprintf(stderr,"\t-0 do not read input, just generate random numbers\n\t\t"
+	  "(needs -l and -r) [Default: not set]\n");
+  fprintf(stderr,"\t-o outfile [Without argument 'datafile'.noi;"
+	  " Without -o stdout is used]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"  -h show these options");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char** in)
+{
+  char *out,lengthset=0;
+  
+  if ((out=check_option(in,n,'l','u')) != NULL) {
+    sscanf(out,"%lu",&length);
+    lengthset=1;
+  }
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'%','f')) != NULL) {
+    sscanf(out,"%lf",&noiselevel);
+    noiselevel /= 100.0;
+  }
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    sscanf(out,"%lf",&noiselevel);
+    absolute=1;
+  }
+  if ((out=check_option(in,n,'g','n')) != NULL)
+    cgaussian=1;
+  if ((out=check_option(in,n,'I','u')) != NULL) {
+    sscanf(out,"%lu",&iseed);
+    if (iseed == 0)
+      iseed=(unsigned long)time((time_t*)&iseed);
+  }
+  if ((out=check_option(in,n,'0','n')) != NULL) {
+    if (absolute && lengthset)
+      justcreate=1;
+    else {
+      fprintf(stderr,"\nThe -0 flag requires -l and -r\n\n");
+      exit(MAKENOISE__FLAGS_REQUIRED);
+    }
+  }
+
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void equidistri(double sigmax,unsigned int which) 
+{
+  int i;
+  double limit,equinorm;
+  
+  equinorm=(double)ULONG_MAX;
+  if (!absolute)
+    limit=2.0*sqrt(3.0)*sigmax*noiselevel;
+  else
+    limit=2.0*noiselevel;
+  for (i=0;i<length;i++)
+    array[which][i] += (limit*((double)rnd_1279()/equinorm-0.5));
+} 
+
+void gauss(double sigmax,unsigned int which)
+{
+  int i;
+  double glevel;
+
+  if (!absolute)
+    glevel=noiselevel*sigmax;
+  else
+    glevel=noiselevel;
+  for (i=0;i<length;i++)
+    array[which][i] += gaussian(glevel);
+}
+
+int main(int argc,char** argv)
+{
+  char stdi=0;
+  unsigned long i,j;
+  double av=0.0,*sigmax;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  if (!justcreate) {
+    infile=search_datafile(argc,argv,NULL,verbosity);
+    if (infile == NULL)
+      stdi=1;
+  }
+  else
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".noi");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.noi");
+    }
+  }
+  if (!stout)
+    test_outfile(outfile);
+
+  if (!justcreate) {
+    if (column == NULL)
+      array=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+				       verbosity);
+    else
+      array=(double**)get_multi_series(infile,&length,exclude,&dim,column,
+				       dimset,verbosity);
+  }
+  else {
+    check_alloc(array=(double**)malloc(sizeof(double*)*dim));
+    for (i=0;i<dim;i++) {
+      check_alloc(array[i]=(double*)malloc(sizeof(double)*length));
+      for (j=0;j<length;j++)
+	array[i][j]=0.0;
+    }
+  }
+
+  check_alloc(sigmax=(double*)malloc(sizeof(double)*dim));
+
+  if (!absolute) {
+    for (j=0;j<dim;j++)
+      variance(array[j],length,&av,&sigmax[j]);
+  }
+
+  rnd_init(iseed);
+
+  for (i=0;i<10000;i++) rnd_1279();
+
+  for (j=0;j<dim;j++) {
+    if (!cgaussian)
+      equidistri(sigmax[j],j);
+    else
+      gauss(sigmax[j],j);
+  }
+
+  if (!stout) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=0;i<length;i++) {
+      for (j=0;j<dim-1;j++)
+	fprintf(fout,"%e ",array[j][i]);
+      fprintf(fout,"%e\n",array[dim-1][i]);
+    }
+    fclose(fout);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=0;i<length;i++) {
+      for (j=0;j<dim-1;j++)
+	fprintf(stdout,"%e ",array[j][i]);
+      fprintf(stdout,"%e\n",array[dim-1][i]);
+    }
+  }
+
+  for (i=0;i<dim;i++)
+    free(array[i]);
+  free(array);
+  free(sigmax);
+  if (outfile != NULL)
+    free(outfile);
+  if (infile != NULL)
+    free(infile);
+  if (column != NULL)
+    free(column);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/mem_spec.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/mem_spec.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,242 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger */
+/*Changes:
+  Feb 19, 2007: changed meaning of -f flag and added -P flag to be 
+                consistent with spectrum
+  Dec 5, 2006: Seg fault when poles > length;
+ */
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <limits.h>
+#include "routines/tsa.h"
+#include <math.h>
+
+#define WID_STR "Estimates the power spectrum of the data"
+
+#ifndef M_PI
+#define M_PI 3.1415926535897932385E0
+#endif
+
+unsigned long poles=128,out=2000;
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int column=1;
+unsigned int verbosity=0x1;
+double samplingrate=1.0;
+char *outfile=NULL,stdo=1;
+char *infile=NULL;
+double *series;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l length of file [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-c column to read [default is 1]\n");
+  fprintf(stderr,"\t-p number of poles [default is 128 or file length]\n");
+  fprintf(stderr,"\t-P number of frequences out [default is 2000]\n");
+  fprintf(stderr,"\t-f sampling rate in Hz [default is 1]\n");
+  fprintf(stderr,"\t-o outfile [default is 'datafile'.spec]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+          "2='+ print the ar coefficients too'\n");
+  fprintf(stderr,"\t-h show these options\n\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *hout;
+  
+  if ((hout=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(hout,"%lu",&length);
+  if ((hout=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(hout,"%lu",&exclude);
+  if ((hout=check_option(argv,argc,'c','u')) != NULL)
+    sscanf(hout,"%u",&column);
+  if ((hout=check_option(argv,argc,'p','u')) != NULL)
+    sscanf(hout,"%lu",&poles);
+  if ((hout=check_option(argv,argc,'P','u')) != NULL)
+    sscanf(hout,"%lu",&out);
+  if ((hout=check_option(argv,argc,'f','f')) != NULL)
+    sscanf(hout,"%lf",&samplingrate);
+  if ((hout=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(hout,"%u",&verbosity);
+  if ((hout=check_option(argv,argc,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(hout) > 0)
+      outfile=hout;
+  }
+}
+
+double getcoefs(double *coef)
+{
+  long i,j,hp=(long)poles-1;
+  double ret=0.0,*cov,*help,h1,h2;
+  
+  check_alloc(cov=(double*)malloc(sizeof(double)*length));
+  check_alloc(help=(double*)malloc(sizeof(double)*poles));
+
+  for (i=0;i<length;i++) 
+    ret += series[i]*series[i];
+  ret /= length;
+  
+  for (i=0;i<length;i++)
+    cov[i]=series[i];
+  series++;
+
+  for (i=0;i<poles;i++) {
+    h1=h2=0.0;
+    for (j=0;j<length-i-1;j++) {
+      h1 += cov[j]*series[j];
+      h2 += cov[j]*cov[j]+series[j]*series[j];
+    }
+    coef[i]=2.0*h1/h2;
+    ret *= (1.0-coef[i]*coef[i]);
+    for (j=0;j<i;j++)
+      coef[j]=help[j]-coef[i]*help[i-1-j];
+    if (i == hp)
+      break;
+    for (j=0;j<=i;j++)
+      help[j]=coef[j];
+    for (j=0;j<length-i-1;j++) {
+      cov[j] -= help[i]*series[j];
+      series[j]=series[j+1]-help[i]*cov[j+1];
+    }
+  }
+  free(cov);
+  free(help);
+
+  return ret;
+}
+double powcoef(double dt,double *coef)
+{
+  int i;
+  double si=0.0,sr=1.0,zr=1.0,zi=0.0,h,omdt,hr,hi;
+  
+  omdt=2.0*M_PI*dt;
+  hr=cos(omdt);
+  hi=sin(omdt);
+  
+  for (i=0;i<poles;i++) {
+    h=zr;
+    zr=zr*hr-zi*hi;
+    zi=h*hi+zi*hr;
+    sr -= coef[i]*zr;
+    si -= coef[i]*zi;
+  }
+  return (sr*sr+si*si);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  double fdt,pm,pow_spec,*cof,av,var;
+  long i;
+  FILE *fout;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+6,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".spec");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)11,(size_t)1));
+      strcpy(outfile,"stdin.spec");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+
+  if (length <= poles) {
+    fprintf(stderr,"\n\tNo. of poles has to be smaller then the length of the\n"
+	    "\tdata set! Exiting.\n");
+    exit(MEM_SPEC_TOO_MANY_POLES);
+  }
+
+  variance(series,length,&av,&var);
+  for (i=0;i<length;i++)
+    series[i] -= av;
+
+  check_alloc(cof=(double*)malloc(sizeof(double)*poles));
+
+  pm=getcoefs(cof);
+
+  if (!stdo) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    if (verbosity&VER_USR1) {
+      fprintf(fout,"#sigma^2=%e\n",pm);
+      for (i=0;i<poles;i++)
+	fprintf(fout,"#%ld %e\n",i+1,cof[i]);
+    }
+    for(i=0;i<out;i++) {
+      fdt=i/(2.0*out);
+      pow_spec=powcoef(fdt,cof);
+      fprintf(fout,"%e %e\n",fdt*samplingrate,
+	      pm/pow_spec/sqrt((double)length));
+      fflush(fout);
+    }
+    fclose(fout);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    if (verbosity&VER_USR1) {
+      fprintf(stdout,"#sigma^2=%e\n",pm);
+      for (i=0;i<poles;i++)
+	fprintf(stdout,"#%ld %e\n",i+1,cof[i]);
+    }
+    for(i=0;i<out;i++) {
+      fdt=i/(2.0*out);
+      pow_spec=powcoef(fdt,cof);
+      fprintf(stdout,"%e %e\n",fdt*samplingrate,
+	      pm/pow_spec/*/sqrt((double)length)*/);
+    }
+  }
+  
+  return 0;
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/mutual.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/mutual.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,206 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified, Sep 20, 2000 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the time delayed mutual information\n\t\
+of the data set"
+
+
+char *file_out=NULL,stout=1;
+char *infile=NULL;
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+long partitions=16,corrlength=20;
+long *array,*h1,*h11,**h2;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of points to be used [Default is all]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default is 0]\n");
+  fprintf(stderr,"\t-c column to read  [Default is 1]\n");
+  fprintf(stderr,"\t-b # of boxes [Default is 16]\n");
+  fprintf(stderr,"\t-D max. time delay [Default is 20]\n");
+  fprintf(stderr,"\t-o output file [-o without name means 'datafile'.mut;"
+	  "\n\t\tNo -o means write to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [Default is 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h  show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char** in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(in,n,'b','u')) != NULL)
+    sscanf(out,"%lu",&partitions);
+  if ((out=check_option(in,n,'D','u')) != NULL)
+    sscanf(out,"%lu",&corrlength);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      file_out=out;
+  }
+}
+
+double make_cond_entropy(long t)
+{
+  long i,j,hi,hii,count=0;
+  double hpi,hpj,pij,cond_ent=0.0,norm;
+
+  for (i=0;i<partitions;i++) {
+    h1[i]=h11[i]=0;
+    for (j=0;j<partitions;j++)
+      h2[i][j]=0;
+  }
+  for (i=0;i<length;i++)
+    if (i >= t) {
+      hii=array[i];
+      hi=array[i-t];
+      h1[hi]++;
+      h11[hii]++;
+      h2[hi][hii]++;
+      count++;
+    }
+
+  norm=1.0/(double)count;
+  cond_ent=0.0;
+
+  for (i=0;i<partitions;i++) {
+    hpi=(double)(h1[i])*norm;
+    if (hpi > 0.0) {
+      for (j=0;j<partitions;j++) {
+	hpj=(double)(h11[j])*norm;
+	if (hpj > 0.0) {
+	  pij=(double)h2[i][j]*norm;
+	  if (pij > 0.0)
+	    cond_ent += pij*log(pij/hpj/hpi);
+	}
+      }
+    }
+  }
+
+  return cond_ent;
+}
+
+int main(int argc,char** argv)
+{
+  char stdi=0;
+  long tau,i;
+  double *series,min,interval,shannon;
+  FILE *file;
+  
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (file_out == NULL) {
+    if (!stdi) {
+      check_alloc(file_out=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(file_out,infile);
+      strcat(file_out,".mut");
+    }
+    else {
+      check_alloc(file_out=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(file_out,"stdin.mut");
+    }
+  }
+  if (!stout)
+    test_outfile(file_out);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  rescale_data(series,length,&min,&interval);
+
+  check_alloc(h1=(long *)malloc(sizeof(long)*partitions));
+  check_alloc(h11=(long *)malloc(sizeof(long)*partitions));
+  check_alloc(h2=(long **)malloc(sizeof(long *)*partitions));
+  for (i=0;i<partitions;i++) 
+    check_alloc(h2[i]=(long *)malloc(sizeof(long)*partitions));
+  check_alloc(array=(long *)malloc(sizeof(long)*length));
+  for (i=0;i<length;i++)
+    if (series[i] < 1.0)
+      array[i]=(long)(series[i]*(double)partitions);
+    else
+      array[i]=partitions-1;
+  free(series);
+
+  shannon=make_cond_entropy(0);
+  if (corrlength >= length)
+    corrlength=length-1;
+
+  if (!stout) {
+    file=fopen(file_out,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",file_out);
+    fprintf(file,"#shannon= %e\n",shannon);
+    fprintf(file,"%d %e\n",0,shannon);
+    for (tau=1;tau<=corrlength;tau++) {
+      fprintf(file,"%ld %e\n",tau,make_cond_entropy(tau));
+      fflush(file);
+    }
+    fclose(file);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"#shannon= %e\n",shannon);
+    fprintf(stdout,"%d %e\n",0,shannon);
+    for (tau=1;tau<=corrlength;tau++) {
+      fprintf(stdout,"%ld %e\n",tau,make_cond_entropy(tau));
+      fflush(stdout);
+    }
+  }
+
+  return 0;
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/new.tgz
Binary file main/system-identification/devel/tisean/source_c/new.tgz has changed
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/nrlazy.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/nrlazy.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,383 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Nov 30, 2000 */
+/*Changes:
+  12/11/05: Going multivariate
+*/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Performs simple noise reduction."
+
+#define BOX (unsigned int)512
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int comp=1,embed=5,delay=1,iterations=1,alldim;
+unsigned int verbosity=0x3;
+char *column=NULL;
+double eps=1.0e-3,epsvar;
+
+char *outfile=NULL,epsset=0,stdo=1,epsvarset=0;
+char *infile=NULL;
+double **series,**corr,*interval,*min,*hcor;
+long **box,*list,**nf;
+unsigned int **indexes;
+char dimset=0;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c column to read [default: 1]\n");
+  fprintf(stderr,"\t-m no. of comp.,embedding dim. [default: %u,%u]\n",
+	  comp,embed);
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-i iterations [default: 1]\n");
+  fprintf(stderr,"\t-r neighborhoud size [default: (interval of data)/1000]\n");
+  fprintf(stderr,"\t-v neighborhoud size (in units of the std. dev. of the "
+	  "data \n\t\t(overwrites -r) [default: not set]\n");
+  fprintf(stderr,"\t-o output file name [Default: 'datafile'.laz.n,"
+	  "\n\t\twhere n is the number of the last iteration,"
+	  "\n\t\twithout -o the last iteration is written to stdout.]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 3]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n\t\t"
+	  "2='+ write output of all iterations to files'\n\t\t"
+	  "4='+ write the number of neighbors found for each point\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','c')) != NULL) {
+    column=out;
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'m','2')) != NULL)
+    sscanf(out,"%u,%u",&comp,&embed);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'i','u')) != NULL)
+    sscanf(out,"%u",&iterations);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&eps);
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'v','f')) != NULL) {
+    epsvarset=1;
+    sscanf(out,"%lf",&epsvar);
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+unsigned int correct(unsigned long n)
+{
+  int i,i1,i2,j,j1,k;
+  int ibox=BOX-1;
+  unsigned int hdel,hcomp;
+  double epsinv,dx;
+  long element,nfound=0;
+
+  epsinv=1./eps;
+
+  for (i=0;i<alldim;i++)
+    hcor[i]=0.0;
+
+  i=(int)(series[0][n]*epsinv)&ibox;
+  j=(int)(series[comp-1][n-(embed-1)*delay]*epsinv)&ibox;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&ibox;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&ibox];
+      while (element != -1) {
+	for (k=0;k<alldim;k++) {
+	  hcomp=indexes[0][k];
+	  hdel=indexes[1][k];
+	  dx=fabs(series[hcomp][n-hdel]-series[hcomp][element-hdel]);
+	  if (dx > eps)
+	    break;
+	}
+	if (k == alldim) {
+	  nfound++;
+	  for (k=0;k<alldim;k++) {
+	    hcomp=indexes[0][k];
+	    hdel=indexes[1][k];
+	    hcor[k] += series[hcomp][element-hdel];
+	  }
+	}
+	element=list[element];
+      }
+    }
+  }
+  for (k=0;k<alldim;k++) {
+    hcomp=indexes[0][k];
+    hdel=indexes[1][k];
+    corr[hcomp][n-hdel] += hcor[k]/nfound;
+    nf[hcomp][n-hdel]++;
+  }
+
+  return nfound;
+}
+
+int main(int argc,char **argv)
+{
+  char *ofname;
+  char stdi=0;
+  int iter;
+  unsigned int *nmf;
+  unsigned long n,i;
+  double dav,dvar,maxinterval,maxdvar;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      check_alloc(ofname=(char*)calloc(strlen(infile)+9,(size_t)1));
+      sprintf(outfile,"%s.laz",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      check_alloc(ofname=(char*)calloc((size_t)14,(size_t)1));
+      sprintf(outfile,"stdin.laz");
+    }
+  }
+  else
+    check_alloc(ofname=(char*)calloc(strlen(outfile)+10,(size_t)1));
+
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&comp,column,
+				      dimset,verbosity);
+
+  check_alloc(interval=(double*)malloc(sizeof(double)*comp));
+  check_alloc(min=(double*)malloc(sizeof(double)*comp));
+
+  maxinterval=maxdvar=0.0;
+  for (i=0;i<comp;i++) {
+    rescale_data(series[i],length,&min[i],&interval[i]);
+    if (interval[i] > maxinterval) maxinterval=interval[i];
+    variance(series[i],length,&dav,&dvar);
+    if (dvar > maxdvar)  maxdvar=dvar;
+  }
+  alldim=comp*embed;
+
+  check_alloc(nmf=(unsigned int*)malloc(sizeof(int)*length));
+  check_alloc(list=(long*)malloc(sizeof(long)*length));
+  check_alloc(box=(long**)malloc(sizeof(long*)*BOX));
+  for (n=0;n<BOX;n++)
+    check_alloc(box[n]=(long*)malloc(sizeof(long)*BOX));
+
+  check_alloc(nf=(long**)malloc(sizeof(long*)*comp));
+  check_alloc(corr=(double**)malloc(sizeof(double*)*comp));
+  for (i=0;i<comp;i++) {
+    check_alloc(nf[i]=(long*)malloc(sizeof(long)*length));
+    check_alloc(corr[i]=(double*)malloc(sizeof(double)*length));
+  }
+
+  indexes=make_multi_index(comp,embed,delay);
+
+  if (epsset)
+    eps/=maxinterval;
+  else
+    eps=1.0/1000.;
+
+  if (epsvarset)
+    eps=epsvar*maxdvar;
+
+  for (iter=1;iter<=iterations;iter++) {
+    make_multi_box2(series,box,list,length,BOX,comp,embed,delay,eps);
+    for (n=0;n<length;n++) {
+      for (i=0;i<comp;i++) {
+	corr[i][n]=0.0;
+	nf[i][n]=0;
+      }
+      nmf[n]=1;
+    }
+    
+    check_alloc(hcor=(double*)malloc(sizeof(double)*alldim));
+    for (n=(embed-1)*delay;n<length;n++)
+      nmf[n]=correct(n);
+    free(hcor);
+    
+    for (n=0;n<length;n++)
+      for (i=0;i<comp;i++)
+	if (nf[i][n])
+	  series[i][n]=corr[i][n]/nf[i][n];
+
+    if ((verbosity&VER_USR1) && (iter < iterations)) {
+      sprintf(ofname,"%s.%d",outfile,iter);
+      test_outfile(ofname);
+      file=fopen(ofname,"w");
+      if (verbosity&VER_INPUT)
+	fprintf(stderr,"Opened %s for writing\n",ofname);
+      if (stdo && (iter == iterations)) {
+	if (verbosity&VER_INPUT)
+	  fprintf(stderr,"Writing to stdout\n");
+      }
+      for (n=0;n<length;n++) {
+	if (stdo && (iter == iterations)) {
+	  if (verbosity&VER_USR2) {
+	    for (i=0;i<comp;i++) 
+	      fprintf(stdout,"%e ",series[i][n]*interval[i]+min[i]);
+	    fprintf(stdout,"%u\n",nmf[n]);
+	  }
+	  else {
+	    fprintf(stdout,"%e",series[0][n]*interval[0]+min[0]);
+	    for (i=1;i<comp;i++)
+	      fprintf(stdout,"%e ",series[i][n]*interval[i]+min[i]);
+	    fprintf(stdout,"\n");
+	  }
+	}
+	if (verbosity&VER_USR2) {
+	  for (i=0;i<comp;i++) 
+	    fprintf(file,"%e ",series[i][n]*interval[i]+min[i]);
+	  fprintf(file,"%u\n",nmf[n]);
+	}
+	else {
+	  fprintf(file,"%e",series[0][n]*interval[0]+min[0]);
+	  for (i=1;i<comp;i++)
+	    fprintf(file," %e",series[i][n]*interval[i]+min[i]);
+	  fprintf(file,"\n");
+	}
+      }
+      fclose(file);
+    }
+    if (iter == iterations) {
+      if (!stdo || (verbosity&VER_USR1)) {
+	sprintf(ofname,"%s.%d",outfile,iter);
+	test_outfile(ofname);
+	file=fopen(ofname,"w");
+	if (verbosity&VER_INPUT)
+	  fprintf(stderr,"Opened %s for writing\n",ofname);
+	if (stdo && (iter == iterations)) {
+	  if (verbosity&VER_INPUT)
+	    fprintf(stderr,"Writing to stdout\n");
+	}
+      }
+      for (n=0;n<length;n++) {
+	if (stdo) {
+	  if (verbosity&VER_USR2) {
+	    for (i=0;i<comp;i++) 
+	      fprintf(stdout,"%e ",series[i][n]*interval[i]+min[i]);
+	    fprintf(stdout,"%u\n",nmf[n]);
+	  }
+	  else {
+	    fprintf(stdout,"%e",series[0][n]*interval[0]+min[0]);
+	    for (i=1;i<comp;i++)
+	      fprintf(stdout," %e",series[i][n]*interval[i]+min[i]);
+	    fprintf(stdout,"\n");
+	  }
+	}
+	if (!stdo || (verbosity&VER_USR1)) {
+	  if (verbosity&VER_USR2) {
+	    for (i=0;i<comp;i++) 
+	      fprintf(file,"%e ",series[i][n]*interval[i]+min[i]);
+	    fprintf(file,"%u\n",nmf[n]);
+	  }
+	  else {
+	    fprintf(file,"%e",series[0][n]*interval[0]+min[0]);
+	    for (i=1;i<comp;i++)
+	      fprintf(file," %e",series[i][n]*interval[i]+min[i]);
+	    fprintf(file,"\n");
+	  }
+	}
+      }
+      if (!stdo || (verbosity&VER_USR1))
+	fclose(file);
+    }
+  }
+
+  /*cleaning up */
+  for (i=0;i<comp;i++) {
+    free(series[i]);
+    free(nf[i]);
+    free(corr[i]);
+  }
+  free(series);
+  free(nf);
+  free(corr);
+
+  for (i=0;i<2;i++)
+    free(indexes[i]);
+  free(indexes);
+
+  free(list);
+  free(nmf);
+  free(interval);
+  free(min);
+
+  for (i=0;i<BOX;i++)
+    free(box[i]);
+  free(box);
+
+  if (outfile != NULL)
+    free(outfile);
+  if (ofname != NULL)
+    free(ofname);
+  if (infile != NULL)
+    free(infile);
+  if (column != NULL)
+    free(column);
+  /* end cleaning up */
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/nstat_z.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/nstat_z.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,486 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 5, 2004 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <ctype.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Tests for nonstationarity by means of the average\n\t\
+forecast error for a zeroth order fit"
+
+
+#ifndef _MATH_H
+#include <math.h>
+#endif
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 128
+
+unsigned int nmax=(NMAX-1);
+long **box,*list;
+unsigned long *found;
+double *series,*series1,*series2;
+double interval,min,epsilon;
+
+char epsset=0,causalset=0;
+char *infile=NULL;
+char *outfile=NULL,stdo=1,centerset=0;
+char *firstwindow,*secondwindow,**window;
+unsigned int COLUMN=1,pieces;
+unsigned int verbosity=0xff;
+int DIM=3,DELAY=1,MINN=30,STEP=1;
+int firstoffset= -1,secondoffset= -1;
+double EPS0=1.e-3,EPSF=1.2;
+unsigned long LENGTH=ULONG_MAX,exclude=0,center,causal;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s -# [other options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c column to read [default: 1]\n");
+  fprintf(stderr,"\t-m embedding dimension [default: 3]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-# # of pieces [no default]\n");
+  fprintf(stderr,"\t-1 which pieces for the first window "
+	  "[default: 1-pieces]\n");
+  fprintf(stderr,"\t-2 which pieces for the second window "
+	  "[default: 1-pieces]\n");
+  fprintf(stderr,"\t-n # of reference points in the window [default: all]\n");
+  fprintf(stderr,"\t-k minimal number of neighbors for the fit "
+	  "[default: 30]\n");
+  fprintf(stderr,"\t-r neighborhoud size to start with "
+	  "[default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-C width of causality window [default: steps]\n");
+  fprintf(stderr,"\t-o output file [default: 'datafile.nsz',"
+	  " without -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n\t The -# option has to be set\n");
+  exit(0);
+}
+
+void parse_minus(char *str,char *array,char *wopt)
+{
+  int cm=0,i,strl,n1,n2;
+  
+  strl=strlen(str);
+  for (i=0;i<strl;i++)
+    if (str[i] == '-')
+      cm++;
+  if (cm > 1) {
+    fprintf(stderr,"Invalid string for the %s option! "
+	    "Please consult the help-page\n",wopt);
+    exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+  }
+  if (cm == 0) {
+    sscanf(str,"%d",&n1);
+    n1--;
+    if (n1 < 0) {
+      fprintf(stderr,"Numbers in %s option must be larger than 0!\n",wopt);
+      exit(NSTAT_Z__NOT_UNSIGNED_FOR_OPTION);
+    }
+    if (n1 >= pieces) {
+      fprintf(stderr,"Numbers in %s option must be smaller than %u!\n",wopt,
+	      pieces);
+      exit(NSTAT_Z__TOO_LARGE_FOR_OPTION);
+    }
+    array[n1]=1;
+  }
+  else {
+    sscanf(str,"%d-%d",&n1,&n2);
+    n1--;
+    n2--;
+    if ((n1 < 0) || (n2 < 0)) {
+      fprintf(stderr,"Numbers in %s option must be larger than 0!\n",wopt);
+      exit(NSTAT_Z__NOT_UNSIGNED_FOR_OPTION);
+    }
+    if ((n1 >= pieces) || (n2 >= pieces)) {
+      fprintf(stderr,"Numbers in %s option must be smaller than %u!\n",wopt,
+	      pieces+1);
+      exit(NSTAT_Z__TOO_LARGE_FOR_OPTION);
+    }
+    if (n2 < n1) {
+      i=n1;
+      n1=n2;
+      n2=i;
+    }
+    for (i=n1;i<=n2;i++)
+      array[i]=1;
+  }
+}
+
+void parse_comma(char *str,char *array,char *wopt)
+{
+  unsigned int strl,i,cp=1,which,iwhich;
+  char **hstr;
+
+  strl=strlen(str);
+  for (i=0;i<strl;i++)
+    if (str[i] == ',')
+      cp++;
+
+  if (cp == 1) {
+    parse_minus(str,array,wopt);
+    return ;
+  }
+  
+  check_alloc(hstr=(char**)malloc(sizeof(char*)*cp));
+  for (i=0;i<cp;i++)
+    check_alloc(hstr[i]=(char*)calloc(strl,1));
+  
+  which=iwhich=0;
+  for (i=0;i<strl;i++) {
+    if (str[i] != ',')
+      hstr[which][iwhich++]=str[i];
+    else {
+      which++;
+      iwhich=0;
+    }
+  }
+  for (i=0;i<cp;i++) {
+    if (hstr[i][0] == '\0') {
+      fprintf(stderr,"Invalid string for the %s option! "
+	      "Please consult the help-page\n",wopt);
+      exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+    }
+    if (!isdigit(hstr[i][strlen(hstr[i])-1])) {
+      fprintf(stderr,"Invalid string for the %s option! "
+	      "Please consult the help-page\n",wopt);
+      exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+    }
+    parse_minus(hstr[i],array,wopt);
+  }
+  for (i=0;i<cp;i++)
+    free(hstr[i]);
+  free(hstr);
+}
+
+void parse_out(char *str,char *array,char *which)
+{
+  unsigned int i;
+  char test;
+
+  for (i=0;i<pieces;i++)
+    array[i]=0;
+  
+  for (i=0;i<strlen(str);i++) {
+    test= (str[i] == '-') || (str[i] == ',') || isdigit(str[i]);
+    if (!test) {
+      fprintf(stderr,"Invalid string for the %s option! "
+	      "Please consult the help-page\n",which);
+      exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+    }
+  }
+  if (!isdigit(str[strlen(str)-1])) {
+    fprintf(stderr,"Invalid string for the %s option! "
+	    "Please consult the help-page\n",which);
+    exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+  }
+  parse_comma(str,array,which);
+}
+
+void parse_offset(char *str,int *iwhich,char *array,char *which) 
+{
+  int i,strl;
+  
+  if (str[0] != '+')
+    return;
+  strl=strlen(str);
+  for (i=1;i<strl;i++)
+    if (!isdigit(str[i])) {
+      fprintf(stderr,"Invalid string for the %s option! "
+	      "Please consult the help-page\n",which);
+      exit(NSTAT_Z__INVALID_STRING_FOR_OPTION);
+    }
+  sscanf(str,"+%d",iwhich);
+  for (i=0;i<pieces;i++)
+    array[i]=0;
+}
+      
+void scan_options(int n,char **in)
+{
+  unsigned int i;
+  char *out,piecesset=0;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&COLUMN);
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&DIM);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'#','u')) != NULL) {
+    sscanf(out,"%u",&pieces);
+    if (pieces < 1)
+      pieces=1;
+    piecesset=1;
+    check_alloc(firstwindow=(char*)malloc(pieces));
+    check_alloc(secondwindow=(char*)malloc(pieces));
+    for (i=0;i<pieces;i++)
+      firstwindow[i]=secondwindow[i]=1;
+    check_alloc(window=(char**)malloc(sizeof(char*)*pieces));
+    for (i=0;i<pieces;i++)
+      check_alloc(window[i]=(char*)malloc(pieces));
+  }
+  if (!piecesset) {
+    fprintf(stderr,"\tThe -# option wasn't set. Please add it!\n");
+    exit(NSTAT_Z__OPTION_NOT_SET);
+  }
+  if ((out=check_option(in,n,'1','s')) != NULL) {
+    parse_offset(out,&firstoffset,firstwindow,"-1");
+    if (firstoffset == -1)
+      parse_out(out,firstwindow,"-1");
+  }
+  if ((out=check_option(in,n,'2','s')) != NULL) {
+    parse_offset(out,&secondoffset,secondwindow,"-2");
+    if (secondoffset == -1)
+      parse_out(out,secondwindow,"-2");
+  }
+  if ((out=check_option(in,n,'n','u')) != NULL) {
+    sscanf(out,"%lu",&center);
+    centerset=1;
+  }
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'C','u')) != NULL) {
+    sscanf(out,"%lu",&causal);
+    causalset=1;
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double make_fit(long act,unsigned long number)
+{
+  double casted=0.0,*help;
+  int i;
+  
+  help=series1+STEP;
+  for (i=0;i<number;i++) {
+    casted += help[found[i]];
+  }
+  casted /= number;
+
+  return sqr(casted-series2[act+STEP]);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  char alldone,*done,sdone;
+  long i,first,second,pstart;
+  unsigned long *hfound;
+  unsigned long actfound;
+  unsigned long clength;
+  double *rms,av,error;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+
+  if (!causalset)
+    causal=STEP;
+
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&COLUMN,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.nsz",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.nsz");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&LENGTH,exclude,COLUMN,verbosity);
+
+  rescale_data(series,LENGTH,&min,&interval);
+  
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(hfound=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(done=(char*)malloc(sizeof(char)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+    
+  if (epsset)
+    EPS0 /= interval;
+
+  clength=(LENGTH-(DIM-1)*DELAY)/pieces;
+  if ((clength-(DIM-1)*DELAY-STEP) < MINN) {
+    fprintf(stderr,"You chose too many pieces and will never find enough"
+	    " neighbors!\n");
+    exit(NSTAT_Z__TOO_MANY_PIECES);
+  }
+  check_alloc(rms=(double*)malloc(sizeof(double)*pieces));
+  for (i=0;i<pieces;i++) {
+    series1=series+i*clength;
+    variance(series1,clength,&av,&rms[i]);
+  }
+  
+  pstart=(DIM-1)*DELAY;
+  if (!centerset)
+    center=clength-STEP;
+  else
+    center=(center < (clength-STEP-pstart)) ? center : clength-STEP-pstart;
+
+  if (stdo) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  for (first=0;first<pieces;first++)
+    for (second=0;second<pieces;second++)
+      window[first][second]=firstwindow[first]&&secondwindow[second];
+  if (firstoffset != -1) {
+    for (second=0;second<pieces;second++)
+      for (first=second-firstoffset;first<=second+firstoffset;first++)
+	if ((first >= 0) && (first < pieces))
+	  window[first][second]=secondwindow[second];
+  }
+  if (secondoffset != -1) {
+    for (first=0;first<pieces;first++)
+      for (second=first-secondoffset;second<=first+secondoffset;second++)
+	if ((second >= 0) && (second < pieces))
+	  window[first][second]=firstwindow[first];
+  }
+
+  free(firstwindow);
+  free(secondwindow);
+
+  for (first=0;first<pieces;first++) {
+    sdone=0;
+    for (second=0;second<pieces;second++) {
+      if (window[first][second]) {
+	sdone=1;
+	series1=series+first*clength;
+	series2=series+second*clength;
+	for (i=0;i<LENGTH;i++)
+	  done[i]=0;
+	alldone=0;
+	epsilon=EPS0/EPSF;
+	error=0.0;
+	while (!alldone) {
+	  alldone=1;
+	  epsilon*=EPSF;
+	  make_box(series1,box,list,clength-STEP,NMAX,(unsigned int)DIM,
+		   (unsigned int)DELAY,epsilon);
+	  for (i=pstart;i<pstart+center;i++)
+	    if (!done[i]) {
+	      actfound=find_neighbors(series1,box,list,series2+i,clength,NMAX,
+				      (unsigned int)DIM,(unsigned int)DELAY,
+				      epsilon,hfound);
+	      actfound=exclude_interval(actfound,i-causal+1,
+					i+causal+pstart-1,hfound,found);
+	      if (actfound >= MINN) {
+		error += make_fit(i,actfound);
+		done[i]=1;
+	      }
+	      alldone &= done[i];
+	    }
+	}
+	if (stdo)
+	  fprintf(stdout,"%ld %ld %e\n",first+1,second+1,
+		  sqrt(error/center)/rms[second]);
+	else {
+	  fprintf(file,"%ld %ld %e\n",first+1,second+1,
+		  sqrt(error/center)/rms[second]);
+	  fflush(file);
+	}
+      }
+    }
+    if (sdone) {
+      if (stdo)
+	fprintf(stdout,"\n");
+      else
+	fprintf(file,"\n");
+    }
+  }
+  
+  if (!stdo)
+    fclose(file);
+
+  if (outfile != NULL)
+    free(outfile);
+  free(list);
+  free(found);
+  free(hfound);
+  free(done);
+  for (i=0;i<NMAX;i++)
+    free(box[i]);
+  free(box);
+  for (i=0;i<pieces;i++)
+    free(window[i]);
+  free(window);
+  free(rms);
+  free(series);
+
+  return 0;
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/pca.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/pca.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,329 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Jul 26, 2004 */
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Performs a global PCA"
+
+unsigned long LENGTH=ULONG_MAX,exclude=0;
+unsigned int DIM=2,EMB=1,dimemb,LDIM=2,DELAY=1;
+unsigned int verbosity=0xff;
+char *outfile=NULL,stout=1,dim_set=0;
+unsigned int what_to_write=0,write_values=1,write_vectors=0;
+unsigned int write_comp=0,write_proj=0;
+unsigned int projection_set=0;
+char *infile=NULL,dimset=0,*column=NULL;
+double **series;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignore [Default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [Default: 2]\n");
+  fprintf(stderr,"\t-m columns,embedding dim. to use [Default: 2,1]\n");
+  fprintf(stderr,"\t-d delay to use [Default: 1]\n");
+  fprintf(stderr,"\t-q projection dimension [Default: no projection]\n");
+  fprintf(stderr,"\t-W # what to write: [Default: 0]\n"
+	  "\t\t0 write eigenvalues only\n"
+	  "\t\t1 write eigenvectors\n"
+	  "\t\t2 write (projected) pca components\n"
+	  "\t\t3 write projected data\n");
+  fprintf(stderr,"\t-o output file name \n\t\t[Default: stdout; -o without "
+	  "value means 'datafile'.pca]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+  
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'m','2')) != NULL) {
+    sscanf(out,"%u,%u",&DIM,&EMB);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'q','u')) != NULL) {
+    sscanf(out,"%u",&LDIM);
+    projection_set=1;
+  }
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'W','u')) != NULL) {
+    sscanf(out,"%u",&what_to_write);
+    switch(what_to_write) {
+    case 0: write_values=1;break;
+    case 1: write_values=0;write_vectors=1;break;
+    case 2: write_values=0;write_comp=1;break;
+    case 3: write_values=0;write_proj=1;break;
+    default: {
+      fprintf(stderr,"Wrong value for the -W flag. Exiting!\n");
+      exit(127);
+    }
+    }
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void ordne(double *lyap,int *ord)
+{
+  long i,j,maxi;
+  double max;
+  
+  for (i=0;i<dimemb;i++)
+    ord[i]=i;
+
+  for (i=0;i<dimemb-1;i++)
+    for (j=i+1;j<dimemb;j++)
+      if (lyap[i] < lyap[j]) {
+	max=lyap[i];
+	lyap[i]=lyap[j];
+	lyap[j]=max;
+	maxi=ord[i];
+	ord[i]=ord[j];
+	ord[j]=maxi;
+      }
+}
+
+void make_pca(double *av)
+{
+  unsigned int i,j,k,i1,i2,j1,j2,k1,k2;
+  int *ord;
+  double **mat,*matarray,*eig,*sp,hsp=0.0;
+  FILE *fout=NULL;
+
+  check_alloc(ord=(int*)malloc(sizeof(int)*dimemb));
+  check_alloc(eig=(double*)malloc(sizeof(double)*dimemb));
+  check_alloc(matarray=(double*)malloc(sizeof(double)*dimemb*dimemb));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*dimemb));
+  for (i=0;i<dimemb;i++)
+    mat[i]=(double*)(matarray+i*dimemb);
+
+  
+  for (i=0;i<dimemb;i++) {
+    i1=i/EMB;
+    i2=(i%EMB)*DELAY;
+    for (j=i;j<dimemb;j++) {
+      j1=j/EMB;
+      j2=(j%EMB)*DELAY;
+      mat[i][j]=0.0;
+      for (k=(EMB-1)*DELAY;k<LENGTH;k++)
+	mat[i][j] += series[i1][k-i2]*series[j1][k-j2];
+      mat[j][i]=(mat[i][j] /= (double)(LENGTH-(EMB-1)*DELAY));
+    }
+  }
+
+  eigen(mat,(unsigned long)dimemb,eig);
+  ordne(eig,ord);
+  
+  if (!stout) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  for (i=0;i<dimemb;i++)
+    if (write_values) {
+      if (stout)
+	fprintf(stdout,"%d %e\n",i,eig[i]);
+      else
+	fprintf(fout,"%d %e\n",i,eig[i]);
+    }
+    else {
+      if (verbosity) {
+	if (stout)
+	  fprintf(stdout,"#%d %e\n",i,eig[i]);
+	else
+	  fprintf(fout,"#%d %e\n",i,eig[i]);
+      }
+    }
+  if (write_vectors) {
+    for (i=0;i<dimemb;i++) {
+      for (j=0;j<dimemb;j++) {
+	j1=ord[j];
+	if (stout)
+	  fprintf(stdout,"%e ",mat[i][j1]);
+	else
+	  fprintf(fout,"%e ",mat[i][j1]);
+      }
+      if (stout)
+	fprintf(stdout,"\n");
+      else
+	fprintf(fout,"\n");
+    }
+  }
+
+  if (write_comp) {
+    for (i=(EMB-1)*DELAY;i<LENGTH;i++) {
+      for (j=0;j<LDIM;j++) {
+	j1=ord[j];
+	hsp=0.0;
+	for (k=0;k<dimemb;k++) {
+	  k1=k/EMB;
+	  k2=(k%EMB)*DELAY;
+	  hsp += mat[k][j1]*(series[k1][i-k2]+av[k1]);
+	}
+	if (stout)
+	  fprintf(stdout,"%e ",hsp);
+	else
+	  fprintf(fout,"%e ",hsp);
+      }
+      if (stout)
+	fprintf(stdout,"\n");
+      else
+	fprintf(fout,"\n");
+    }
+  }
+
+  if (write_proj) {
+    check_alloc(sp=(double*)malloc(sizeof(double)*LDIM));
+    for (i=0;i<(EMB-1)*DELAY;i++) {
+      for (j=0;j<DIM;j++)
+	if (stout)
+	  fprintf(stdout,"%e ",series[j][i]+av[j]);
+	else
+	  fprintf(fout,"%e ",series[j][i]+av[j]);
+      if (stout)
+	fprintf(stdout,"\n");
+      else
+	fprintf(fout,"\n");
+    }
+    for (i=(EMB-1)*DELAY;i<LENGTH;i++) {
+      for (j=0;j<LDIM;j++) {
+	j1=ord[j];
+	sp[j]=0.0;
+	for (k=0;k<dimemb;k++) {
+	  k1=k/EMB;
+	  k2=(k%EMB)*DELAY;
+	  sp[j] += mat[k][j1]*series[k1][i-k2];
+	}
+      }
+      for (j=0;j<DIM;j++) {
+	hsp=0.0;
+	for (k=0;k<LDIM;k++) {
+	  k1=ord[k];
+	  hsp += mat[j*EMB][k1]*sp[k];
+	}
+	if (stout)
+	  fprintf(stdout,"%e ",hsp+av[j]);
+	else
+	  fprintf(fout,"%e ",hsp+av[j]);
+      }
+      if (stout)
+	fprintf(stdout,"\n");
+      else
+	fprintf(fout,"\n");
+    }
+    free(sp);
+  }
+
+  if (!stout)
+    fclose(fout);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  unsigned int i,j;
+  double rms,*av;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".pca");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.pca");
+    }
+  }
+  if (!stout)
+    test_outfile(outfile);
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&DIM,"",dimset,
+                                      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&LENGTH,exclude,&DIM,column,
+                                      dimset,verbosity);
+  dimemb=DIM*EMB;
+  if (!projection_set)
+    LDIM=dimemb;
+  else {
+    if (LDIM < 1) LDIM=1;
+    if (LDIM > dimemb) LDIM=dimemb;
+  }
+
+  check_alloc(av=(double*)malloc(sizeof(double)*DIM));
+  for (j=0;j<DIM;j++) {
+    av[j]=rms=0.0;
+    variance(series[j],LENGTH,&av[j],&rms);
+    for (i=0;i<LENGTH;i++)
+      series[j][i] -= av[j];
+  }
+  make_pca(av);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/poincare.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/poincare.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,241 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, Last modified: Mar 20, 1999 */
+#include <string.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Make a Poincare section"
+
+char *outfile=NULL,dimset=0,compset=0,whereset=0,stdo=1;
+char *infile=NULL;
+unsigned long length=ULONG_MAX,count,exclude=0;
+int dim=2,comp=2,delay=1,dir=0;
+unsigned int column=1;
+unsigned int verbosity=0xff;
+double *series,min,max,average=0.0,where;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of points to be used [Default: whole file]\n");
+  fprintf(stderr,"\t-x #of lines to be ignored [Default: 0]\n");
+  fprintf(stderr,"\t-c column to read  [Default: 1]\n");
+  fprintf(stderr,"\t-m embedding dimension [Default: 2]\n");
+  fprintf(stderr,"\t-d delay [Default: 1]\n");
+  fprintf(stderr,"\t-q component to cut [Default: last]\n");
+  fprintf(stderr,"\t-C direction of the cut (0: from below,1: from above)"
+	  "\n\t\t[Default: 0]\n");
+  fprintf(stderr,"\t-a set crossing at [Default: average of data]\n");
+  fprintf(stderr,"\t-o outfile [Default: 'datafile'.poin]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h  show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+
+void scan_options(int n,char** in)
+{
+  char *out;
+  
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(in,n,'m','u')) != NULL) {
+    dimset=1;
+    sscanf(out,"%u",&dim);
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'q','u')) != NULL) {
+    compset=1;
+    sscanf(out,"%u",&comp);
+  }
+  if ((out=check_option(in,n,'C','u')) != NULL)
+    sscanf(out,"%u",&dir);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'a','f')) != NULL) {
+    whereset=1;
+    sscanf(out,"%lf",&where);
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void poincare(void)
+{
+  unsigned long i;
+  long j,jd;
+  double delta,xcut;
+  double time=0.0,lasttime=0.0;
+  FILE *fout=NULL;
+
+  if (!stdo) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  if (dir == 0) {
+    for (i=(comp-1)*delay;i<length-(dim-comp)*delay-1;i++) {
+      if ((series[i] < where) && (series[i+1] >= where)) {
+	delta=(series[i]-where)/(series[i]-series[i+1]);
+	time=(double)i+delta;
+	if (lasttime > 0.0) {
+	  for (j= -(comp-1);j<=dim-comp;j++) {
+	    if (j != 0) {
+	      jd=i+j*delay;
+	      xcut=series[jd]+delta*(series[jd+1]-series[jd]);
+	      if (!stdo)
+		fprintf(fout,"%e ",xcut);
+	      else
+		fprintf(stdout,"%e ",xcut);
+	    }
+	  }
+	  if (!stdo) {
+	    fprintf(fout,"%e\n",time-lasttime);
+	    fflush(fout);
+	  }
+	  else {
+	    fprintf(stdout,"%e\n",time-lasttime);
+	    fflush(stdout);
+	  }
+	  count++;
+	}
+	lasttime=time;
+      }
+    }
+  }
+  else {
+    for (i=(comp-1)*delay;i<length-(dim-comp)*delay-1;i++) {
+      if ((series[i] > where) && (series[i+1] <= where)) {
+	delta=(series[i]-where)/(series[i]-series[i+1]);
+	time=(double)i+delta;
+	if (lasttime > 0.0) {
+	  for (j= -(comp-1);j<=dim-comp;j++) {
+	    if (j != 0) {
+	      jd=i+j*delay;
+	      xcut=series[jd]+delta*(series[jd+1]-series[jd]);
+	      if (!stdo)
+		fprintf(fout,"%e ",xcut);
+	      else
+		fprintf(stdout,"%e ",xcut);
+	    }
+	  }
+	  if (!stdo) {
+	    fprintf(fout,"%e\n",time-lasttime);
+	    fflush(fout);
+	  }
+	  else {
+	    fprintf(stdout,"%e\n",time-lasttime);
+	    fflush(stdout);
+	  }
+	  count++;
+	}
+	lasttime=time;
+      }
+    }
+  }
+  if (!stdo)
+    fclose(fout);
+}
+
+int main(int argc,char** argv)
+{
+  char stdi=0;
+  long i;
+  double var;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+6,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".poin");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)11,(size_t)1));
+      strcpy(outfile,"stdin.poin");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  variance(series,length,&average,&var);
+  min=max=series[0];
+  for (i=1;i<length;i++) {
+    if (series[i] < min) min=series[i];
+    if (series[i] > max) max=series[i];
+  }
+
+  if (!whereset)
+    where=average;
+  if (dimset && !compset)
+    comp=dim;
+  
+  if (comp > dim) {
+    fprintf(stderr,"Component to cut is larger than dimension. Exiting!\n");
+    exit(POINCARE__WRONG_COMPONENT);
+  }
+  if ((where < min) || (where > max)) {
+    fprintf(stderr,"You want to cut outside the data interval which is [%e,"
+	    "%e]\n",min,max);
+    exit(POINCARE__OUTSIDE_REGION);
+  }
+  poincare();
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/polyback.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/polyback.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,355 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified Sep 4, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include <time.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Does a backward elimination for a polynomial"
+
+char *outfile=NULL,stdo=1;
+char *parin=NULL,*infile=NULL;
+unsigned long length=ULONG_MAX,insample=ULONG_MAX,exclude=0;
+unsigned int plength=UINT_MAX;
+unsigned int column=1,dim=2,delay=1,down_to=1,step=1;
+unsigned int **order;
+unsigned int verbosity=0xff;
+double *series,*param;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [Options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [default: %lu]\n",exclude);
+  fprintf(stderr,"\t-c column to read [default: %u]\n",column);
+  fprintf(stderr,"\t-m embedding dimension [default: %u]\n",dim);
+  fprintf(stderr,"\t-d delay [default: %u]\n",delay);
+  fprintf(stderr,"\t-n insample data [default: all]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: %u]\n",step);
+  fprintf(stderr,"\t-# reduce down to # terms [default: %u]\n",down_to);
+  fprintf(stderr,"\t-p name of parameter file [default: parameter.pol]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile'.pbe]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+  
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&dim);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&insample);
+  if ((out=check_option(in,n,'#','u')) != NULL)
+    sscanf(out,"%u",&down_to);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&step);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'p','s')) != NULL)
+    parin=out;
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double polynom(unsigned long act,unsigned int which)
+{
+  unsigned int i,j;
+  double ret=1.0,h;
+  
+  for (i=0;i<dim;i++) {
+    h=series[act-i*delay];
+    for (j=0;j<order[which][i];j++)
+      ret *= h;
+  }
+  
+  return ret;
+}
+
+void make_fit(void)
+{
+  double **mat,*vec;
+  double h;
+  unsigned long n;
+  unsigned int i,j;
+
+  check_alloc(vec=(double*)malloc(sizeof(double)*plength));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*plength));
+  for (i=0;i<plength;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*plength));
+
+  for (i=0;i<plength;i++) {
+    vec[i]=0.0;
+    for (j=0;j<plength;j++)
+      mat[i][j]=0.0;
+  }
+  
+  for (n=(dim-1)*delay;n<insample-step;n++) {
+    for (i=0;i<plength;i++) {
+      vec[i] += series[n+step]*(h=polynom(n,i));
+      for (j=i;j<plength;j++)
+	mat[i][j] += polynom(n,j)*h;
+    }
+  }
+  for (i=0;i<plength;i++) {
+    vec[i] /= (insample-step-(dim-1)*delay);
+    for (j=i;j<plength;j++)
+      mat[j][i]=(mat[i][j]/=(insample-step-(dim-1)*delay));
+  }
+  
+  solvele(mat,vec,plength);
+
+  for (i=0;i<plength;i++)
+    param[i]=vec[i];
+
+  free(vec);
+  for (i=0;i<plength;i++)
+    free(mat[i]);
+  free(mat);
+}
+
+double forecast_error(unsigned long i0,unsigned long i1)
+{
+  unsigned int i;
+  unsigned long n;
+  double h,error=0.0;
+
+  for (n=i0+(dim-1)*delay;n<i1-step;n++) {
+    h=0.0;
+    for (i=0;i<plength;i++)
+      h += param[i]*polynom(n,i);
+    error += (series[n+step]-h)*(series[n+step]-h);
+  }
+  
+  return sqrt(error/(i1-i0-step-(dim-1)*delay));
+}
+
+int main(int argc,char **argv)
+{
+  int i,j,k,l,hl,ibest,counter;
+  char stdi=0,out_set=1,*parout;
+  double **dummy,besti,besto,withalli,withallo,errori=0.,erroro=0.;
+  double av,varianz;
+  unsigned long hlength=ULONG_MAX;
+  unsigned int **ini_params,*isout,offset;
+  FILE *file,*fpars;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.pbe",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.pbe");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (parin == NULL) {
+    check_alloc(parin=(char*)calloc((size_t)14,(size_t)1));
+    sprintf(parin,"parameter.pol");
+  }
+  file=fopen(parin,"r");
+  if (file == NULL) {
+    fprintf(stderr,"File %s does not exist. Exiting!\n",parin);
+    exit(POLYBACK__WRONG_PARAMETER_FILE);
+  }
+  fclose(file);
+
+  if (verbosity&VER_INPUT)
+    fprintf(stderr,"Using %s as the parameter file\n",parin);
+  dummy=(double**)get_multi_series(parin,&hlength,0LU,&dim,"",(char)1,
+				   verbosity);
+
+  offset=(unsigned int)(log((double)hlength)/log(10.0)+1.0);
+  check_alloc(parout=(char*)calloc(strlen(parin)+offset+2,(size_t)1));
+  
+  check_alloc(ini_params=(unsigned int**)malloc(sizeof(int*)*hlength));
+  for (i=0;i<hlength;i++) {
+    check_alloc(ini_params[i]=(unsigned int*)malloc(sizeof(int)*dim));
+    for (j=0;j<dim;j++)
+      ini_params[i][j]=(unsigned int)dummy[j][i];
+  }
+  check_alloc(isout=(unsigned int*)malloc(sizeof(int)*hlength));
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  variance(series,length,&av,&varianz);
+
+  if (insample >= length) {
+    insample=length;
+    out_set=0;
+  }
+
+  check_alloc(order=(unsigned int**)malloc(sizeof(int*)*hlength));
+  check_alloc(param=(double*)malloc(sizeof(double)*hlength));
+  for (i=0;i<hlength;i++) {
+    isout[i]=0;
+    check_alloc(order[i]=(unsigned int*)malloc(sizeof(int)*dim));
+    for (j=0;j<dim;j++)
+      order[i][j]=ini_params[i][j];
+  }
+  plength=hlength;
+
+  make_fit();
+  withalli=forecast_error(0LU,insample);
+  withallo=0.0;
+  if (out_set)
+    withallo=forecast_error(insample+1,length);
+
+  if (stdo) {
+    fprintf(stdout,"%lu %e %e\n",hlength,withalli/varianz,withallo/varianz);
+    fflush(stdout);
+  }
+  else {
+    file=fopen(outfile,"w");
+    fprintf(file,"%lu %e %e\n",hlength,withalli/varianz,withallo/varianz);
+    fflush(file);
+  }
+  free(param);
+  for (i=0;i<plength;i++)
+    free(order[i]);
+  free(order);
+  
+  if ((down_to < 1) || (down_to > hlength))
+    down_to=1;
+
+  for (i=1;i<=hlength-down_to;i++) {
+    plength=hlength-i;
+    besti=besto=0.0;
+    ibest= -1;
+    check_alloc(order=(unsigned int**)malloc(sizeof(int*)*plength));
+    check_alloc(param=(double*)malloc(sizeof(double)*plength));
+    for (j=0;j<plength;j++) {
+      check_alloc(order[j]=(unsigned int*)malloc(sizeof(int)*dim));
+    }
+    counter=plength;
+    for (j=0;j<hlength;j++)
+      if (!isout[j]) {
+	isout[j]++;
+	hl=0;
+	for (k=0;k<hlength;k++) {
+	  if (!isout[k]) {
+	    for (l=0;l<dim;l++)
+	      order[hl][l]=ini_params[k][l];
+	    hl++;
+	  }
+	}
+	make_fit();
+	errori=forecast_error(0LU,insample);
+	if (out_set)
+	  erroro=forecast_error(insample+1,length);
+	if (ibest == -1) {
+	  besti=errori;
+	  if (out_set)
+	    besto=erroro;
+	  ibest=j;
+	}
+	else {
+	  if (out_set) {
+	    if (erroro < besto) {
+	      besto=erroro;
+	      besti=errori;
+	      ibest=j;
+	    }
+	  }
+	  else {
+	    if (errori < besti) {
+	      besti=errori;
+	      besto=erroro;
+	      ibest=j;
+	    }
+	  }
+	}
+	isout[j]--;
+      }
+    isout[ibest]++;
+    free(param);
+    for (j=0;j<plength;j++)
+      free(order[j]);
+    free(order);
+    if (stdo) {
+      fprintf(stdout,"%u %e %e ",plength,besti/varianz,besto/varianz);
+      for (j=0;j<dim;j++)
+	fprintf(stdout,"%u ",ini_params[ibest][j]);
+      fprintf(stdout,"\n");
+      fflush(stdout);
+    }
+    else {
+      fprintf(file,"%u %e %e ",plength,besti/varianz,besto/varianz);
+      for (j=0;j<dim;j++)
+	fprintf(file,"%u ",ini_params[ibest][j]);
+      fprintf(file,"\n");
+      fflush(file);
+    }
+    sprintf(parout,"%s.%u",parin,plength);
+    fpars=fopen(parout,"w");
+    for (j=0;j<hlength;j++)
+      if (!isout[j]) {
+	for (k=0;k<dim;k++)
+	  fprintf(fpars,"%u ",ini_params[j][k]);
+	fprintf(fpars,"\n");
+      }
+    fclose(fpars);
+  }
+ 
+  if (!stdo)
+    fclose(file);
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/polynom.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/polynom.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,322 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger*/
+/* Changes:
+   6/30/2006: Norm of the errors was wrong
+*/
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Fits a polynomial to the data"
+
+char CAST=0,sinsample=0,*outfile=NULL;
+char *infile=NULL;
+unsigned long LENGTH=ULONG_MAX,exclude=0;
+long CLENGTH=1000;
+unsigned long INSAMPLE=ULONG_MAX;
+int DIM=2,DELAY=1,N=2;
+unsigned int COLUMN=1;
+unsigned int pars=1,hpar;
+unsigned int verbosity=0xff;
+
+long *coding;
+long maxencode;
+double *series,*results;
+double std_dev;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c column to read [default: 1]\n");
+  fprintf(stderr,"\t-m embedding dimension [default: 2]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-p order of the polynomial [default: 2]\n");
+  fprintf(stderr,"\t-n # of points for insample [default: # of data]\n");
+  fprintf(stderr,"\t-L steps to cast [default: none]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile'.pol]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&COLUMN);
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&DIM);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'p','u')) != NULL)
+    sscanf(out,"%u",&N);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'n','u')) != NULL) {
+    sscanf(out,"%lu",&INSAMPLE);
+    sinsample=1;
+  }
+  if ((out=check_option(in,n,'L','u')) != NULL) {
+    CAST=1;
+    sscanf(out,"%lu",&CLENGTH);
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL)
+    if (strlen(out) > 0)
+      outfile=out;
+}
+
+double polynom(int act,int dim,long cur,long fac)
+{
+  int j,n,hi;
+  double ret=1.0;
+
+  n=cur/fac;
+  hi=act-(dim-1)*DELAY;
+  for (j=1;j<=n;j++)
+    ret *= series[hi];
+  if (dim > 1) 
+    ret *= polynom(act,dim-1,cur-n*fac,fac/(N+1));
+
+  return ret;
+}
+
+int number_pars(int ord,int start)
+{
+  int i,ret=0;
+
+  if (ord == 1)
+    for (i=start;i<=DIM;i++)
+      ret += 1;
+  else
+    for (i=start;i<=DIM;i++)
+      ret += number_pars(ord-1,i);
+
+  return ret;
+}
+
+void make_coding(int ord,int d,int fac,int cur)
+{
+  int j;
+
+  if ( d == -1)
+    coding[hpar++]=cur;
+  else
+    for (j=0;j<=ord;j++)
+      make_coding(ord-j,d-1,fac*(N+1),cur+j*fac);
+}
+
+void make_fit(void)
+{
+  int i,j,k;
+  double **mat,*b;
+  
+  check_alloc(b=(double*)malloc(sizeof(double)*pars));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*pars));
+  for (i=0;i<pars;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*pars));
+
+  for (i=0;i<pars;i++) {
+    b[i]=0.0;
+    for (j=0;j<pars;j++)
+      mat[i][j]=0.0;
+  }
+
+  for (i=0;i<pars;i++)
+    for (j=i;j<pars;j++)
+      for (k=(DIM-1)*DELAY;k<INSAMPLE-1;k++)
+	mat[i][j] += polynom(k,DIM,coding[i],maxencode)*
+	  polynom(k,DIM,coding[j],maxencode);
+  for (i=0;i<pars;i++)
+    for (j=i;j<pars;j++)
+      mat[j][i]=(mat[i][j] /= (INSAMPLE-1-(DIM-1)*DELAY));
+
+  for (i=0;i<pars;i++) {
+    for (j=(DIM-1)*DELAY;j<INSAMPLE-1;j++)
+      b[i] += series[j+1]*polynom(j,DIM,coding[i],maxencode);
+    b[i] /= (INSAMPLE-1-(DIM-1)*DELAY);
+  }
+  solvele(mat,b,pars);
+
+  for (i=0;i<pars;i++)
+    results[i]=b[i];
+  
+  free(b);
+  for (i=0;i<pars;i++)
+    free(mat[i]);
+  free(mat);
+}
+
+void decode(int *out,int dim,long cur,long fac)
+{
+  int n;
+  
+  n=cur/fac;
+  out[dim]=n;
+  if (dim > 0) 
+    decode(out,dim-1,cur-(long)n*fac,fac/(N+1));
+}
+
+double make_error(unsigned long i0,unsigned long i1)
+{
+  int j,k;
+  double h,err;
+  
+  err=0.0;
+  for (j=i0+(DIM-1)*DELAY;j<(long)i1-1;j++) {
+    h=0.0;
+    for (k=0;k<pars;k++) 
+      h += results[k]*polynom(j,DIM,coding[k],maxencode);
+    err += (series[j+1]-h)*(series[j+1]-h);
+  }
+  return err /= ((long)i1-(long)i0-(DIM-1)*DELAY);
+}
+
+void make_cast(FILE *fcast)
+{
+  int i,j,k,hi;
+  double casted;
+  
+  for (i=0;i<=(DIM-1)*DELAY;i++)
+    series[i]=series[LENGTH-(DIM-1)*DELAY-1+i];
+
+  hi=(DIM-1)*DELAY;
+  for (i=1;i<=CLENGTH;i++) {
+    casted=0.0;
+    for (k=0;k<pars;k++)
+      casted += results[k]*polynom((DIM-1)*DELAY,DIM,coding[k],maxencode);
+    fprintf(fcast,"%e\n",casted*std_dev);
+    fflush(fcast);
+    for (j=0;j<(DIM-1)*DELAY;j++)
+      series[j]=series[j+1];
+    series[hi]=casted;
+  }
+  fclose(fcast);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  int i,j,k;
+  int *opar,sumpar;
+  double in_error,out_error,av;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&COLUMN,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".pol");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.pol");
+    }
+  }
+  test_outfile(outfile);
+
+  series=(double*)get_series(infile,&LENGTH,exclude,COLUMN,verbosity);
+  variance(series,LENGTH,&av,&std_dev);
+  for (i=0;i<LENGTH;i++)
+    series[i] /= std_dev;
+
+  if (!sinsample || (INSAMPLE > LENGTH))
+    INSAMPLE=LENGTH;
+
+  maxencode=1;
+  for (i=1;i<DIM;i++)
+    maxencode *= (N+1);
+  
+  for (i=1;i<=N;i++) {
+    pars += number_pars(i,1);
+  }
+  file=fopen(outfile,"w");
+  if (verbosity&VER_INPUT)
+    fprintf(stderr,"Opened %s for writing\n",outfile);
+  fprintf(file,"#number of free parameters= %d\n\n",pars);
+  fflush(file);
+  check_alloc(coding=(long*)malloc(sizeof(long)*pars));
+  hpar=0;
+  make_coding(N,DIM-1,1,0);
+
+  check_alloc(results=(double*)malloc(sizeof(double)*pars));
+  make_fit();
+
+  check_alloc(opar=(int*)malloc(sizeof(int)*DIM));
+  fprintf(file,"#used norm for the fit= %e\n",std_dev);
+
+  for (j=0;j<pars;j++) {
+    decode(opar,DIM-1,coding[j],maxencode);
+    fprintf(file,"#");
+    sumpar=0;
+    for (k=0;k<DIM;k++) {
+      sumpar += opar[k];
+      fprintf(file,"%d ",opar[k]);
+    }
+    fprintf(file,"%e\n",results[j]/pow(std_dev,(double)(sumpar-1)));
+  }
+  fprintf(file,"\n");
+
+  in_error=make_error((unsigned long)0,INSAMPLE);
+
+  fprintf(file,"#average insample error= %e\n",sqrt(in_error));
+
+  if (INSAMPLE < LENGTH) {
+    out_error=make_error(INSAMPLE,LENGTH);
+    fprintf(file,"#average out of sample error= %e\n",sqrt(out_error));
+  }
+
+  if (CAST)
+    make_cast(file);
+  fclose(file);
+  
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/polynomp.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/polynomp.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,299 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified Sep 5, 2004 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include <time.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Fits a polynomial to the data."
+
+char *outfile=NULL,stdo=1;
+char *parin=NULL,*infile=NULL;
+unsigned long length=ULONG_MAX,insample=ULONG_MAX,exclude=0;
+unsigned long plength=UINT_MAX;
+unsigned long step=1000;
+unsigned int column=1,dim=2,delay=1,down_to=1;
+unsigned int **order;
+unsigned int verbosity=0xff;
+double *series,*param;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [Options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [default: %lu]\n",exclude);
+  fprintf(stderr,"\t-c column to read [default: %u]\n",column);
+  fprintf(stderr,"\t-m embedding dimension [default: %u]\n",dim);
+  fprintf(stderr,"\t-d delay [default: %u]\n",delay);
+  fprintf(stderr,"\t-n insample data [default: all]\n");
+  fprintf(stderr,"\t-L length of forecasted series [default: %lu]\n",step);
+  fprintf(stderr,"\t-p name of parameter file [default: parameter.pol]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile'.pbf]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&dim);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&insample);
+  if ((out=check_option(in,n,'L','u')) != NULL)
+    sscanf(out,"%lu",&step);
+  if ((out=check_option(in,n,'p','s')) != NULL)
+    parin=out;
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  } 
+}
+
+double polynom(unsigned long act,unsigned int which)
+{
+  unsigned int i,j;
+  double ret=1.0,h;
+  
+  for (i=0;i<dim;i++) {
+    h=series[act-i*delay];
+    for (j=0;j<order[which][i];j++)
+      ret *= h;
+  }
+  
+  return ret;
+}
+
+void make_fit(void)
+{
+  double **mat,*vec;
+  double h;
+  unsigned long n,hn;
+  unsigned int i,j;
+
+  check_alloc(vec=(double*)malloc(sizeof(double)*plength));
+  check_alloc(mat=(double**)malloc(sizeof(double*)*plength));
+  for (i=0;i<plength;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*plength));
+
+  for (i=0;i<plength;i++) {
+    vec[i]=0.0;
+    for (j=0;j<plength;j++)
+      mat[i][j]=0.0;
+  }
+  
+  for (n=(dim-1)*delay;n<insample-1;n++) {
+    hn=n+1;
+    for (i=0;i<plength;i++) {
+      vec[i] += series[hn]*(h=polynom(n,i));
+      for (j=i;j<plength;j++)
+	mat[i][j] += polynom(n,j)*h;
+    }
+  }
+  for (i=0;i<plength;i++) {
+    vec[i] /= (insample-(dim-1)*delay-1);
+    for (j=i;j<plength;j++)
+      mat[j][i]=(mat[i][j]/=(insample-(dim-1)*delay)-1);
+  }
+  
+  solvele(mat,vec,plength);
+
+  for (i=0;i<plength;i++)
+    param[i]=vec[i];
+
+  free(vec);
+  for (i=0;i<plength;i++)
+    free(mat[i]);
+  free(mat);
+}
+
+double forecast_error(unsigned long i0,unsigned long i1)
+{
+  unsigned int i;
+  unsigned long n;
+  double h,error=0.0;
+
+  for (n=i0+(dim-1)*delay;n<i1-1;n++) {
+    h=0.0;
+    for (i=0;i<plength;i++)
+      h += param[i]*polynom(n,i);
+    error += (series[n+1]-h)*(series[n+1]-h);
+  }
+
+  return sqrt(error/(i1-i0-(dim-1)*delay-1));
+}
+
+void make_cast(FILE *fcast)
+{
+  int i,j,hi;
+  unsigned int k;
+  double casted;
+  
+  for (i=0;i<=(dim-1)*delay;i++)
+    series[i]=series[length-(dim-1)*delay+i-1];
+
+  hi=(dim-1)*delay;
+  for (i=1;i<=step;i++) {
+    casted=0.0;
+    for (k=0;k<plength;k++)
+      casted += param[k]*polynom((unsigned long)((dim-1)*delay),k);
+    if (!stdo) {
+      fprintf(fcast,"%e\n",casted);
+      fflush(fcast);
+    }
+    else {
+      fprintf(stdout,"%e\n",casted);
+      fflush(stdout);
+    }
+    for (j=0;j<(dim-1)*delay;j++)
+      series[j]=series[j+1];
+    series[hi]=casted;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  int i,j;
+  char stdi=0,oose=1;
+  double **dummy,withalli,withallo;
+  double av,varianz;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.pbf",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.pbf");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (parin == NULL) {
+    check_alloc(parin=(char*)calloc((size_t)14,(size_t)1));
+    sprintf(parin,"parameter.pol");
+  }
+  file=fopen(parin,"r");
+  if (file == NULL) {
+    fprintf(stderr,"File %s does not exist. Exiting!\n",parin);
+    exit(POLYNOMP__WRONG_PARAMETER_FILE);
+  }
+  fclose(file);
+
+  dummy=(double**)get_multi_series(parin,&plength,0LU,
+				   &dim,"",(char)"1",verbosity);
+  
+  check_alloc(order=(unsigned int**)malloc(sizeof(int*)*plength));
+  for (i=0;i<plength;i++) {
+    check_alloc(order[i]=(unsigned int*)malloc(sizeof(int)*dim));
+    for (j=0;j<dim;j++)
+      order[i][j]=(unsigned int)dummy[j][i];
+  }
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  variance(series,length,&av,&varianz);
+
+  if (insample >= length) {
+    insample=length;
+    oose=0;
+  }
+
+  check_alloc(param=(double*)malloc(sizeof(double)*plength));
+
+  make_fit();
+  withalli=forecast_error(0LU,insample);
+  withallo=0.0;
+  if (oose)
+    withallo=forecast_error(insample+1,length);
+
+  if (stdo) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"#FCE: %e %e\n",withalli/varianz,withallo/varianz);
+    for (i=0;i<plength;i++) {
+      fprintf(stdout,"# ");
+      for (j=0;j<dim;j++)
+	fprintf(stdout,"%u ",order[i][j]);
+      fprintf(stdout,"%e\n",param[i]);
+    }
+    fflush(stdout);
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(file,"#FCE: %e %e\n",withalli/varianz,withallo/varianz);
+    for (i=0;i<plength;i++) {
+      fprintf(file,"# ");
+      for (j=0;j<dim;j++)
+	fprintf(file,"%u ",order[i][j]);
+      fprintf(file,"%e\n",param[i]);
+    }
+    fflush(file);
+  }
+  
+  make_cast(file);
+
+  if (!stdo)
+    fclose(file);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/polypar.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/polypar.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,121 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 4, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Creates a parameter file containing all terms\n\t\
+for a polynomial"
+
+
+char *outfile=NULL;
+unsigned int dim=2,order=3;
+unsigned int verbosity=0xff;
+FILE *file=NULL;
+
+void make_parameter(unsigned int*,unsigned int, unsigned int);
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"\t-m embedding dimension [Default: %u]\n",dim);
+  fprintf(stderr,"\t-p order of the polynomial [Default: %u]\n",order);
+  fprintf(stderr,"\t-o parameter file [Default: parameter.pol]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&dim);
+  if ((out=check_option(in,n,'p','u')) != NULL)
+    sscanf(out,"%u",&order);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void make_parameter(unsigned int *par,unsigned int d,unsigned int sum)
+{
+  int i,j;
+  
+  for (i=0;i<=order;i++) {
+    sum += i;
+    if (sum <= order) {
+      par[d]=i;
+      if (d == 0) {
+	for (j=0;j<dim;j++)
+	  fprintf(file,"%u ",par[j]);
+	fprintf(file,"\n");
+      }
+      else
+	make_parameter(par,d-1,sum);
+    }
+    sum -= i;
+  }
+  par[d]=0;
+}
+
+int main(int argc,char **argv)
+{
+  unsigned int i,*params;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  
+  if (outfile == NULL) {
+    check_alloc(outfile=(char*)calloc((size_t)14,(size_t)1));
+    sprintf(outfile,"parameter.pol");
+  }
+  test_outfile(outfile);
+
+  check_alloc(params=(unsigned int*)malloc(sizeof(unsigned int)*dim));
+  for (i=0;i<dim;i++)
+    params[i]=0;
+
+  file=fopen(outfile,"w");
+  if (verbosity&VER_INPUT)
+    fprintf(stderr,"Opened %s for writing\n",outfile);
+  make_parameter(params,dim-1,0);
+  fclose(file);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/rbf.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/rbf.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,383 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Mar 11, 2002 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+#include <math.h>
+
+#define WID_STR "Fits a RBF-model to the data"
+
+char *outfile=NULL,stdo=1,MAKECAST=0;
+char *infile=NULL;
+char setdrift=1;
+int DIM=2,DELAY=1,CENTER=10,STEP=1;
+unsigned int COLUMN=1;
+unsigned int verbosity=0xff;
+long CLENGTH=1000;
+unsigned long LENGTH=ULONG_MAX,INSAMPLE=ULONG_MAX,exclude=0;
+
+double *series,*coefs;
+double varianz,interval,min;
+double **center;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: all from file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c column to read [default: %u]\n",COLUMN);
+  fprintf(stderr,"\t-m embedding dimension [default: %d]\n",DIM);
+  fprintf(stderr,"\t-d delay [default: %d]\n",DELAY);
+  fprintf(stderr,"\t-p number of centers [default: %d]\n",CENTER);
+  fprintf(stderr,"\t-X deactivate drift [default: activated]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: %d]\n",STEP);
+  fprintf(stderr,"\t-n # of points for insample [default: # of data]\n");
+  fprintf(stderr,"\t-L steps to cast [default: none]\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile'.rbf]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','u')) != NULL)
+    sscanf(out,"%u",&COLUMN);
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&DIM);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'p','u')) != NULL)
+    sscanf(out,"%u",&CENTER);
+  if ((out=check_option(in,n,'X','n')) != NULL)
+    setdrift=0;
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&INSAMPLE);
+  if ((out=check_option(in,n,'L','u')) != NULL) {
+    MAKECAST=1;
+    sscanf(out,"%lu",&CLENGTH);
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double avdistance(void)
+{
+  int i,j,k;
+  double dist=0.0;
+  
+  for (i=0;i<CENTER;i++)
+    for (j=0;j<CENTER;j++)
+      if (i != j)
+	for (k=0;k<DIM;k++)
+	  dist += sqr(center[i][k]-center[j][k]);
+
+  return sqrt(dist/(CENTER-1)/CENTER/DIM);
+}
+
+double rbf(double *act,double *cen)
+{
+  static double denum;
+  double r=0;
+  int i;
+
+  denum=2.0*varianz*varianz;
+
+  for (i=0;i<DIM;i++)
+    r += sqr(*(act-i*DELAY)-cen[i]);
+  
+  return exp(-r/denum);
+}
+
+void drift(void) 
+{
+  double *force,h,h1,step=1e-2,step1;
+  int i,j,k,l,d2=DIM;
+
+  check_alloc(force=(double*)malloc(sizeof(double)*d2));
+  for (l=0;l<20;l++) {
+    for (i=0;i<CENTER;i++) {
+      for (j=0;j<d2;j++) {
+        force[j]=0.0;
+        for (k=0;k<CENTER;k++) {
+          if (k != i) {
+            h=center[i][j]-center[k][j];
+            force[j] += h/sqr(h)/fabs(h);
+          }
+        }
+      }
+      h=0.0;
+      for (j=0;j<d2;j++) 
+        h += sqr(force[j]);
+      step1=step/sqrt(h);
+      for (j=0;j<d2;j++) {
+        h1 = step1*force[j];
+        if (((center[i][j]+h1) > -0.1) && ((center[i][j]+h1) < 1.1))
+          center[i][j] += h1;
+      }
+    }
+  }
+  free(force);
+}
+
+void make_fit(void)
+{
+  double **mat,*hcen;
+  double h;
+  int i,j,n,nst;
+
+  check_alloc(mat=(double**)malloc(sizeof(double*)*(CENTER+1)));
+  for (i=0;i<=CENTER;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*(CENTER+1)));
+  check_alloc(hcen=(double*)malloc(sizeof(double)*CENTER));
+
+  for (i=0;i<=CENTER;i++) {
+    coefs[i]=0.0;
+    for (j=0;j<=CENTER;j++)
+      mat[i][j]=0.0;
+  }
+
+  for (n=(DIM-1)*DELAY;n<INSAMPLE-STEP;n++) {
+    nst=n+STEP;
+    for (i=0;i<CENTER;i++)
+      hcen[i]=rbf(&series[n],center[i]);
+    coefs[0] += series[nst];
+    mat[0][0] += 1.0;
+    for (i=1;i<=CENTER;i++)
+      mat[i][0] += hcen[i-1];
+    for (i=1;i<=CENTER;i++) {
+      coefs[i] += series[nst]*(h=hcen[i-1]);
+      for (j=1;j<=i;j++)
+	mat[i][j] += h*hcen[j-1];
+    }
+  }
+  
+  h=(double)(INSAMPLE-STEP-(DIM-1)*DELAY);
+  for (i=0;i<=CENTER;i++) {
+    coefs[i] /= h;
+    for (j=0;j<=i;j++) {
+      mat[i][j] /= h;
+      mat[j][i]=mat[i][j];
+    }
+  }
+
+  solvele(mat,coefs,(unsigned int)(CENTER+1));
+
+  for (i=0;i<=CENTER;i++)
+    free(mat[i]);
+  free(mat);
+  free(hcen);
+}
+
+double forecast_error(unsigned long i0,unsigned long i1)
+{
+  int i,n;
+  double h,error=0.0;
+
+  for (n=i0+(DIM-1)*DELAY;n<i1-STEP;n++) {
+    h=coefs[0];
+    for (i=1;i<=CENTER;i++)
+      h += coefs[i]*rbf(&series[n],center[i-1]);
+    error += (series[n+STEP]-h)*(series[n+STEP]-h);
+  }
+  
+  return sqrt(error/(i1-i0-STEP-(DIM-1)*DELAY));
+}
+
+void make_cast(FILE *out)
+{
+  double *cast,new_el;
+  int i,n,dim;
+  
+  dim=(DIM-1)*DELAY;
+  check_alloc(cast=(double*)malloc(sizeof(double)*(dim+1)));
+  for (i=0;i<=dim;i++)
+    cast[i]=series[LENGTH-1-dim+i];
+  
+  for (n=0;n<CLENGTH;n++) {
+    new_el=coefs[0];
+    for (i=1;i<=CENTER;i++)
+      new_el += coefs[i]*rbf(&cast[dim],center[i-1]);
+    fprintf(out,"%e\n",new_el*interval+min);
+    for (i=0;i<dim;i++)
+      cast[i]=cast[i+1];
+    cast[dim]=new_el;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  int i,j,cstep;
+  double sigma,av;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&COLUMN,verbosity);
+  if (infile == NULL) 
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".rbf");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.rbf");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&LENGTH,exclude,COLUMN,verbosity);
+  rescale_data(series,LENGTH,&min,&interval);
+  variance(series,LENGTH,&av,&varianz);
+
+  if (INSAMPLE > LENGTH)
+    INSAMPLE=LENGTH;
+  
+  if (CENTER > LENGTH) 
+    CENTER = LENGTH;
+  
+  if (MAKECAST)
+    STEP=1;
+  
+  check_alloc(coefs=(double*)malloc(sizeof(double)*(CENTER+1)));
+  check_alloc(center=(double**)malloc(sizeof(double*)*CENTER));
+  for (i=0;i<CENTER;i++)
+    check_alloc(center[i]=(double*)malloc(sizeof(double)*DIM));
+  
+  cstep=LENGTH-1-(DIM-1)*DELAY;
+  for (i=0;i<CENTER;i++)
+    for (j=0;j<DIM;j++)
+      center[i][j]=series[(DIM-1)*DELAY-j*DELAY+(i*cstep)/(CENTER-1)];
+
+  if (setdrift)
+    drift();
+  varianz=avdistance();
+  make_fit();
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(file,"#Center points used:\n");
+    for (i=0;i<CENTER;i++) {
+      fprintf(file,"#");
+      for (j=0;j<DIM;j++)
+	fprintf(file," %e",center[i][j]*interval+min);
+      fprintf(file,"\n");
+    }
+    fprintf(file,"#variance= %e\n",varianz*interval);
+    fprintf(file,"#Coefficients:\n");
+    fprintf(file,"#%e\n",coefs[0]*interval+min);
+    for (i=1;i<=CENTER;i++)
+      fprintf(file,"#%e\n",coefs[i]*interval);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"#Center points used:\n");
+    for (i=0;i<CENTER;i++) {
+      fprintf(stdout,"#");
+      for (j=0;j<DIM;j++)
+	fprintf(stdout," %e",center[i][j]*interval+min);
+      fprintf(stdout,"\n");
+    }
+    fprintf(stdout,"#variance= %e\n",varianz*interval);
+    fprintf(stdout,"#Coefficients:\n");
+    fprintf(stdout,"#%e\n",coefs[0]*interval+min);
+    for (i=1;i<=CENTER;i++)
+      fprintf(stdout,"#%e\n",coefs[i]*interval);
+  }
+  av=sigma=0.0;
+  for (i=0;i<INSAMPLE;i++) {
+    av += series[i];
+    sigma += series[i]*series[i];
+  }
+  av /= INSAMPLE;
+  sigma=sqrt(fabs(sigma/INSAMPLE-av*av));
+  if (!stdo)
+    fprintf(file,"#insample error= %e\n",forecast_error(0LU,INSAMPLE)/sigma);
+  else
+    fprintf(stdout,"#insample error= %e\n",forecast_error(0LU,INSAMPLE)/sigma);
+
+  if (INSAMPLE < LENGTH) {
+    av=sigma=0.0;
+    for (i=INSAMPLE;i<LENGTH;i++) {
+      av += series[i];
+      sigma += series[i]*series[i];
+    }
+    av /= (LENGTH-INSAMPLE);
+    sigma=sqrt(fabs(sigma/(LENGTH-INSAMPLE)-av*av));
+    if (!stdout)
+      fprintf(file,"#out of sample error= %e\n",
+	      forecast_error(INSAMPLE,LENGTH)/sigma);
+    else
+      fprintf(stdout,"#out of sample error= %e\n",
+	      forecast_error(INSAMPLE,LENGTH)/sigma);
+  }
+
+  if (MAKECAST) {
+    if (!stdo)
+      make_cast(file);
+    else
+      make_cast(stdout);
+  }
+
+  if (!stdo)
+    fclose(file);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/recurr.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/recurr.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,225 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified:  Sep 16, 2004 */
+/* Sep 16, 2004: Change of index in output. before 0->N-1 now 1->N
+ */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "This programs makes a recurrence plot for the data."
+
+#define BOX 1024
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int embed=2,dim=1,delay=1;
+unsigned int verbosity=0xff;
+double eps=1.e-3,fraction=1.0;
+char dimset=0;
+char *columns;
+char *outfile=NULL,stdo=1;
+char *infile=NULL;
+char epsset=0;
+
+double **series;
+long **box,*list;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"Usage: %s [options]\n",progname);
+  fprintf(stderr,"Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [Default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [Default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [Default: 1]\n");
+  fprintf(stderr,"\t-m # of components,embedding dimension [Default: 1,2]\n");
+  fprintf(stderr,"\t-d delay [Default: 1]\n");
+  fprintf(stderr,"\t-r size of the neighbourhood "
+	  "[Default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-%% print only a percentage of points found [Default: "
+	  " 100.0]\n");
+  fprintf(stderr,"\t-o output file name [Default: 'datafile'.rec\n"
+	  "\t\twithout -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [Default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    columns=out;
+  if ((out=check_option(in,n,'m','2')) != NULL) {
+    sscanf(out,"%u,%u",&dim,&embed);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&delay);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&eps);
+  }
+  if ((out=check_option(in,n,'%','f')) != NULL) {
+    sscanf(out,"%lf",&fraction);
+    fraction /= 100.0;
+  }
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+void lfind_neighbors(void)
+{
+  int i,i1,i2,j,j1,ke,ked,kd;
+  int ibox=BOX-1;
+  long n,element;
+  double dx,epsinv;
+  char toolarge;
+  FILE *fout=NULL;
+
+  epsinv=1./eps;
+  rnd_init(0x9834725L);
+
+  if (!stdo) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  for (n=(embed-1)*delay;n<length;n++) {
+    i=(int)(series[0][n]*epsinv)&ibox;
+    j=(int)(series[dim-1][n]*epsinv)&ibox;
+    for (i1=i-1;i1<=i+1;i1++) {
+      i2=i1&ibox;
+      for (j1=j-1;j1<=j+1;j1++) {
+	element=box[i2][j1&ibox];
+	while (element > n) {
+	  toolarge=0;
+	  for (ke=0;ke<embed;ke++) {
+	    ked=ke*delay;
+	    for (kd=0;kd<dim;kd++) {
+	      dx=fabs(series[kd][n-ked]-series[kd][element-ked]);
+	      if (dx >= eps) {
+		toolarge=1;
+		break;
+	      }
+	    }
+	    if (toolarge)
+	      break;
+	  }
+	  if (!toolarge)
+	    if (((double)rnd69069()/ULONG_MAX) <= fraction) {
+	      if (!stdo)
+		fprintf(fout,"%ld %ld\n",n+1,element+1);
+	      else
+		fprintf(stdout,"%ld %ld\n",n+1,element+1);
+	    }
+	  element=list[element];
+	}
+      }
+    }
+  }
+  if (!stdo)
+    fclose(fout);
+}
+
+int main(int argc,char **argv)
+{
+  long i;
+  char stdi=0;
+  double min,max,maxmax;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".rec");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.rec");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (columns == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+                                      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,columns,
+                                      dimset,verbosity);
+
+  maxmax=0.0;
+  for (i=0;i<dim;i++) {
+    rescale_data(series[i],length,&min,&max);
+    if (max > maxmax)
+      maxmax=max;
+  }
+
+  if (epsset)
+    eps /= maxmax;
+
+  check_alloc(list=(long*)malloc(sizeof(long)*length));
+  check_alloc(box=(long**)malloc(sizeof(long*)*BOX));
+  for (i=0;i<BOX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*BOX));
+
+  make_multi_box(series,box,list,length,BOX,dim,embed,delay,eps);
+  lfind_neighbors();
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/resample.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/resample.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,174 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger, Last modified: Mar 11, 2002 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Resample the data"
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int column=1,order=4;
+unsigned int verbosity=0xff;
+char *outfile=NULL,stdo=1;
+char *infile=NULL;
+double *series,sampletime=0.5;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+	  " as a possible"
+	  " datafile.\nIf no datafile is given stdin is read. Just - also"
+	  " means stdin\n");
+  fprintf(stderr,"\t-l length of file [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default is 0]\n");
+  fprintf(stderr,"\t-c column to read [default is 1]\n");
+  fprintf(stderr,"\t-s new sampling time (in units of the old one)"
+	  " [default is %f]\n",sampletime);
+  fprintf(stderr,"\t-p order of the interpolation [default is %d]\n",order);
+  fprintf(stderr,"\t-o output file name [default is 'datafile'.rs]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,argc,'s','f')) != NULL)
+    sscanf(out,"%lf",&sampletime);
+  if ((out=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,argc,'c','u')) != NULL)
+    sscanf(out,"%u",&column);
+  if ((out=check_option(argv,argc,'p','u')) != NULL)
+    sscanf(out,"%u",&order);
+  if ((out=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,argc,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  long i,j,itime,itime_old;
+  int horder,horder2;
+  double **mat,*vec,**imat,*coef;
+  double time,htime,new_el;
+  FILE *file=NULL;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,&column,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".rs");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)9,(size_t)1));
+      strcpy(outfile,"stdin.rs");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  series=(double*)get_series(infile,&length,exclude,column,verbosity);
+  
+  horder=order+1;
+  horder2=(horder+1)/2-horder;
+
+  check_alloc(mat=(double**)malloc(sizeof(double*)*horder));
+  for (i=0;i<horder;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*horder));
+  check_alloc(vec=(double*)malloc(sizeof(double)*horder));
+  check_alloc(coef=(double*)malloc(sizeof(double)*horder));
+  
+  for (i=0;i<horder;i++)
+    for (j=0;j<horder;j++)
+      mat[i][j]=pow((double)(horder2+i),(double)j);
+
+  imat=invert_matrix(mat,(unsigned int)horder);
+
+  if (!stdo) {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+  }
+
+  time=(horder+1)/2.;
+  itime_old= -1;
+  while (time < (double)(length-horder/2)) {
+    itime=(int)time+horder2;
+    if (itime != itime_old) {
+      for (i=0;i<horder;i++)
+	vec[i]=series[i+itime];
+      for (i=0;i<horder;i++) {
+	coef[i]=0.0;
+	for (j=0;j<horder;j++)
+	  coef[i] += imat[i][j]*vec[j];
+      }
+    }
+    itime_old=itime;
+    htime=time-itime+horder2;
+    new_el=coef[0];
+    for (i=1;i<horder;i++)
+      new_el += coef[i]*pow(htime,(double)i);
+    if (stdo)
+      fprintf(stdout,"%e\n",new_el);
+    else
+      fprintf(file,"%e\n",new_el);
+    time += sampletime;
+  }
+  if (!stdo)
+    fclose(file);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/rescale.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/rescale.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,185 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Nov 23, 2000 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include <math.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Rescales the data"
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int dim=1;
+unsigned int verbosity=0xff;
+char *column=NULL;
+char *outfile=NULL,stdo=1,set_av=0,set_var=0,dimset=0;
+char *infile=NULL;
+double **series;
+double xmin=0.0,xmax=1.0;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to ignore [default: 0]\n");
+  fprintf(stderr,"\t-m # of components to be read [default: %u]\n",dim);
+  fprintf(stderr,"\t-c columns to read [default: 1,...,# of components]\n");
+  fprintf(stderr,"\t-z minimum of the new series [default: 0.0]\n");
+  fprintf(stderr,"\t-Z maximum of the new series [default: 1.0]\n");
+  fprintf(stderr,"\t-a create a series with average value equals 0\n");
+  fprintf(stderr,"\t-v create a series with variance 1\n");
+  fprintf(stderr,"\t-o output file name [default: 'datafile'.res']\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    column=out;
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'z','f')) != NULL)
+    sscanf(out,"%lf",&xmin);
+  if ((out=check_option(in,n,'Z','f')) != NULL)
+    sscanf(out,"%lf",&xmax);
+  if ((out=check_option(in,n,'a','n')) != NULL)
+    set_av=1;
+  if ((out=check_option(in,n,'v','n')) != NULL)
+    set_var=1;
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  FILE *file;
+  double min,max;
+  double av,varianz;
+  long i,n;
+    
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".res");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.res");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (xmin >= xmax) {
+    fprintf(stderr,"Choosing the minimum larger or equal the maximum\n"
+	    "makes no sense. Exiting!\n");
+    exit(RESCALE__WRONG_INTERVAL);
+  }
+
+  if (column == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",dimset,
+				      verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,column,
+				      dimset,verbosity);
+
+  for (n=0;n<dim;n++) {
+    variance(series[n],length,&av,&varianz);
+    
+    if (set_av)
+      for (i=0;i<length;i++)
+	series[n][i] -= av;
+
+    if (set_var)
+      for (i=0;i<length;i++)
+	series[n][i] /= varianz;
+  
+    if (!set_var && !set_av) {
+      rescale_data(series[n],length,&min,&max);
+      for (i=0;i<length;i++)
+	series[n][i]=series[n][i]*(xmax-xmin)+xmin;
+    }
+  }
+
+  if (stdo) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=0;i<length;i++) {
+      fprintf(stdout,"%e",series[0][i]);
+      for (n=1;n<dim;n++)
+	fprintf(stdout," %e",series[n][i]);
+      fprintf(stdout,"\n");
+    }
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=0;i<length;i++) {
+      fprintf(file,"%e",series[0][i]);
+      for (n=1;n<dim;n++)
+	fprintf(file," %e",series[n][i]);
+      fprintf(file,"\n");
+    }
+    fclose(file);
+  }
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/Makefile.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/Makefile.in	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,21 @@
+SHELL = /bin/sh
+
+AR = @AR@
+ARFLAGS = @ARFLAGS@
+CC = @CC@
+CFLAGS = @CFLAGS@
+RANLIB = @RANLIB@
+
+ALL = get_series.o rescale_data.o make_box.o\
+	find_neighbors.o scan_help.o variance.o get_multi_series.o\
+	search_datafile.o check_option.o solvele.o rand.o eigen.o\
+	test_outfile.o invert_matrix.o exclude_interval.o make_multi_box.o\
+	find_multi_neighbors.o check_alloc.o myfgets.o what_i_do.o\
+	make_multi_index.o make_multi_box2.o rand_arb_dist.o
+
+libddtsa.a: $(ALL)
+	$(AR) $(ARFLAGS) libddtsa.a $?
+	$(RANLIB) libddtsa.a
+
+clean:
+	@rm -f *.a *.o *~ #*#
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/arima.tgz
Binary file main/system-identification/devel/tisean/source_c/routines/arima.tgz has changed
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/check_alloc.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/check_alloc.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,31 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/* Author: Rainer Hegger Last modified: Jul 15, 1999 */
+#include <stdlib.h>
+#include <stdio.h>
+#include "tisean_cec.h"
+
+void check_alloc(void *pnt)
+{
+  if (pnt == NULL) {
+    fprintf(stderr,"check_alloc: Couldn't allocate enough memory. Exiting\n");
+    exit(CHECK_ALLOC_NOT_ENOUGH_MEMORY);
+  }
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/check_option.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/check_option.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,252 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Aug 19, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include "tisean_cec.h"
+
+extern void check_alloc(void*);
+/* possible types are
+   'd'  (long) integer
+   'u'  unsigned (long)
+   '1'  one or two unsigned (long) numbers, separated by comma, if two
+   '2'  two unsigned (long) numbers separated by a comma
+   '3' three unsigned (long) numbers separated by commas
+   'f'  float
+   's'  string
+   'o'  optional string (must only begin with a minus if there is no space)
+   'n'  no parameter
+   */
+
+void check_unsigned(char *tocheck,int which)
+{
+  int i,n;
+  char ok=1;
+
+  n=strlen(tocheck);
+  for (i=0;i<n;i++)
+    if (!isdigit((unsigned int)tocheck[i]))
+      ok=0;
+
+  if (!ok) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be an "
+	    "unsigned integer\n",which);
+    exit(CHECK_OPTION_NOT_UNSIGNED);
+  }
+}
+
+void check_integer(char *tocheck,int which)
+{
+  int i,n;
+  char ok=1;
+
+  n=strlen(tocheck);
+  ok=(tocheck[0] == '-') || isdigit((unsigned int)tocheck[0]);
+  if (ok)
+    for (i=1;i<n;i++)
+      if (!isdigit((unsigned int)tocheck[i]))
+	ok=0;
+  
+  if (!ok) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be an "
+	    "integer\n",which);
+    exit(CHECK_OPTION_NOT_INTEGER);
+  }
+}
+
+void check_float(char *tocheck,int which)
+{
+  double dummy;
+  int found;
+  char *rest;
+  
+  check_alloc(rest=(char*)calloc(strlen(tocheck)+1,(size_t)1));
+  found=sscanf(tocheck,"%lf%s",&dummy,rest);
+  if (found != 1) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be a "
+	    "float\n",which);
+    exit(CHECK_OPTION_NOT_FLOAT);
+  }
+  free(rest);
+}
+
+void check_two(char *tocheck,int which)
+{
+  int i,j;
+  unsigned int len;
+
+  len=(unsigned int)strlen(tocheck);
+  for (i=0;i<len;i++)
+    if (tocheck[i] == ',')
+      break;
+  if (i >= (len-1)) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	    " unsigned,unsigned\n",which);
+    exit(CHECK_OPTION_NOT_TWO);
+  }
+  for (j=0;j<i;j++)
+    if (!isdigit((unsigned int)tocheck[j])) {
+      fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	      " unsigned,unsigned\n",which);
+      exit(CHECK_OPTION_NOT_TWO);
+    }
+  for (j=i+1;j<len;j++)
+    if (!isdigit((unsigned int)tocheck[j])) {
+      fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	      " unsigned,unsigned\n",which);
+      exit(CHECK_OPTION_NOT_TWO);
+    }
+}
+
+void check_three(char *tocheck,int which)
+{
+  int i,j,k;
+  unsigned int len;
+
+  len=(unsigned int)strlen(tocheck);
+  for (i=0;i<len;i++)
+    if (tocheck[i] == ',')
+      break;
+
+  if (i >= (len-1)) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	    " unsigned,unsigned,unsigned\n",which);
+    exit(CHECK_OPTION_NOT_THREE);
+  }
+
+  for (j=i+1;j<len;j++)
+    if (tocheck[j] == ',')
+      break;
+
+  if (j >= (len-1)) {
+    fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	    " unsigned,unsigned,unsigned\n",which);
+    exit(CHECK_OPTION_NOT_THREE);
+  }
+
+  for (k=0;k<i;k++)
+    if (!isdigit((unsigned int)tocheck[k])) {
+      fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	      " unsigned,unsigned,unsigned\n",which);
+      exit(CHECK_OPTION_NOT_THREE);
+    }
+  for (k=i+1;k<j;k++)
+    if (!isdigit((unsigned int)tocheck[k])) {
+      fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	      " unsigned,unsigned,unsigned\n",which);
+      exit(CHECK_OPTION_NOT_THREE);
+    }
+  for (k=j+1;k<len;k++)
+    if (!isdigit((unsigned int)tocheck[k])) {
+      fprintf(stderr,"Wrong type of parameter for flag -%c. Has to be"
+	      " unsigned,unsigned,unsigned\n",which);
+      exit(CHECK_OPTION_NOT_THREE);
+    }
+}
+
+char check_optional(char *tocheck,int which)
+{
+  if (tocheck[0] == '-') {
+    fprintf(stderr,"If you want to give the -%c flag a parameter starting"
+	    " with a - don't put a space. Ignoring it.\n",which);
+    return 0;
+  }
+  return 1;
+}
+
+char* check_option(char **in,int n,int which,int type)
+{
+  char test,*ret=NULL,wasfound=0,ok=1;
+  int i;
+  
+  for (i=1;i<n;i++) {
+    if (in[i] != NULL) {
+      test= (in[i][0] == '-') && (in[i][1] == which);
+      if (test) {
+	wasfound=1;
+	if (type != 'n') {
+	  if (strlen(in[i]) > 2) {
+	    switch(type) {
+	    case 'u': check_unsigned(in[i]+2,which);break;
+	    case 'd': check_integer(in[i]+2,which);break;
+	    case 'f': check_float(in[i]+2,which);break;
+	    case '2': check_two(in[i]+2,which);break;
+	    case '3': check_three(in[i]+2,which);break;
+	    }
+	    if (ret != NULL)
+	      free(ret);
+	    check_alloc(ret=(char*)calloc(strlen(in[i]+2)+1,(size_t)1));
+	    strcpy(ret,in[i]+2);
+	    in[i]=NULL;
+	  }
+	  else {
+	    in[i]=NULL;
+	    i++;
+	    if (i < n) {
+	      if (in[i] != NULL) {
+		switch(type) {
+		case 'u': check_unsigned(in[i],which);break;
+		case 'd': check_integer(in[i],which);break;
+		case 'f': check_float(in[i],which);break;
+		case '2': check_two(in[i],which);break;
+   	        case '3': check_three(in[i]+2,which);break;
+		case 'o': ok=check_optional(in[i],which);break;
+		}
+		if (ok) {
+		  if (ret != NULL)
+		    free(ret);
+		  check_alloc(ret=(char*)calloc(strlen(in[i])+1,(size_t)1));
+		  strcpy(ret,in[i]);
+		  in[i]=NULL;
+		}
+		else {
+		  i--;
+		  if (ret != NULL)
+		    free(ret);
+		  ret=NULL;
+		}
+	      }
+	    }
+	    else {
+	      if (ret != NULL) {
+		free(ret);
+		ret=NULL;
+	      }
+	    }
+	  }
+	}
+	else {
+	  in[i]=NULL;
+	}
+      }
+    }
+  }
+  
+  if (((type == 'o') || (type == 'n')) && (ret == NULL) && wasfound)
+    return "";
+
+  if (wasfound && (ret == NULL)) {
+    fprintf(stderr,"The option -%c needs some value. Exiting!\n",which);
+    exit(CHECK_OPTION_C_NO_VALUE);
+  }
+  return ret;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/diffc.log
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/diffc.log	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,11 @@
+--- get_multi_series.c	2004-07-23 10:01:25.000000000 +0200
++++ /home/hegger/TISEAN_2.1/source_c/routines/get_multi_series.c	2000-05-26 08:24:44.000000000 +0200
+@@ -135,7 +135,7 @@
+ 	    fprintf(stderr,"Line %lu ignored: %s",allcount,input);
+ 	  break;
+ 	}
+-      if ((count == 0) && (i == *col) && (verbosity&VER_FIRST_LINE)) {
++      if ((verbosity&VER_FIRST_LINE) && (count == 0)) {
+ 	fprintf(stderr,"get_multi_series: first data item(s) used:\n");
+ 	for (i=0;i< *col;i++)
+ 	  fprintf(stderr,"%lf ",x[i][0]);
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/diffh.log
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/eigen.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/eigen.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,522 @@
+#include <math.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include "tisean_cec.h"
+
+typedef double doublereal;
+typedef int integer;
+
+#define abs(x) (((x)>=0.0)?(x):-(x))
+#define min(x,y) (((x)<=(y))?(x):(y))
+#define max(x,y) (((x)>=(y))?(x):(y))
+
+static doublereal c_b10 = 1.;
+
+extern void check_alloc(void*);
+
+double d_sign(double *a,double *b)
+{
+  double x;
+  x = (*a >= 0 ? *a : - *a);
+  return ( *b >= 0 ? x : -x);
+}
+
+doublereal pythag(doublereal *a, doublereal *b)
+{
+    doublereal ret_val, d__1, d__2, d__3;
+    static doublereal p, r__, s, t, u;
+
+    d__1 = abs(*a), d__2 = abs(*b);
+    p = max(d__1,d__2);
+    if (p == 0.) {
+	goto L20;
+    }
+    d__2 = abs(*a), d__3 = abs(*b);
+    d__1 = min(d__2,d__3) / p;
+    r__ = d__1 * d__1;
+L10:
+    t = r__ + 4.;
+    if (t == 4.) {
+	goto L20;
+    }
+    s = r__ / t;
+    u = s * 2. + 1.;
+    p = u * p;
+    d__1 = s / u;
+    r__ = d__1 * d__1 * r__;
+    goto L10;
+L20:
+    ret_val = p;
+    return ret_val;
+}
+
+
+int tred2(integer *nm, integer *n, doublereal *a, 
+	doublereal *d__, doublereal *e, doublereal *z__)
+{
+    integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2, i__3;
+    doublereal d__1;
+
+    double sqrt(doublereal), d_sign(doublereal *, doublereal *);
+
+    static doublereal f, g, h__;
+    static integer i__, j, k, l;
+    static doublereal hh;
+    static integer ii, jp1;
+    static doublereal scale;
+
+
+
+/*     this subroutine is a translation of the algol procedure tred2, */
+/*     num. math. 11, 181-195(1968) by martin, reinsch, and wilkinson. */
+/*     handbook for auto. comp., vol.ii-linear algebra, 212-226(1971). */
+
+/*     this subroutine reduces a real symmetric matrix to a */
+/*     symmetric tridiagonal matrix using and accumulating */
+/*     orthogonal similarity transformations. */
+
+/*     on input */
+
+/*        nm must be set to the row dimension of two-dimensional */
+/*          array parameters as declared in the calling program */
+/*          dimension statement. */
+
+/*        n is the order of the matrix. */
+
+/*        a contains the real symmetric input matrix.  only the */
+/*          lower triangle of the matrix need be supplied. */
+
+/*     on output */
+
+/*        d contains the diagonal elements of the tridiagonal matrix. */
+
+/*        e contains the subdiagonal elements of the tridiagonal */
+/*          matrix in its last n-1 positions.  e(1) is set to zero. */
+
+/*        z contains the orthogonal transformation matrix */
+/*          produced in the reduction. */
+
+/*        a and z may coincide.  if distinct, a is unaltered. */
+
+/*     questions and comments should be directed to burton s. garbow, */
+/*     mathematics and computer science div, argonne national laboratory */
+
+/*     this version dated august 1983. */
+
+/*     ------------------------------------------------------------------ */
+
+    z_dim1 = *nm;
+    z_offset = 1 + z_dim1 * 1;
+    z__ -= z_offset;
+    --e;
+    --d__;
+    a_dim1 = *nm;
+    a_offset = 1 + a_dim1 * 1;
+    a -= a_offset;
+
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+
+	i__2 = *n;
+	for (j = i__; j <= i__2; ++j) {
+	    z__[j + i__ * z_dim1] = a[j + i__ * a_dim1];
+	}
+
+	d__[i__] = a[*n + i__ * a_dim1];
+    }
+
+    if (*n == 1) {
+	goto L510;
+    }
+    i__1 = *n;
+    for (ii = 2; ii <= i__1; ++ii) {
+	i__ = *n + 2 - ii;
+	l = i__ - 1;
+	h__ = 0.;
+	scale = 0.;
+	if (l < 2) {
+	    goto L130;
+	}
+	i__2 = l;
+	for (k = 1; k <= i__2; ++k) {
+	    scale += (d__1 = d__[k], abs(d__1));
+	}
+
+	if (scale != 0.) {
+	    goto L140;
+	}
+L130:
+	e[i__] = d__[l];
+
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    d__[j] = z__[l + j * z_dim1];
+	    z__[i__ + j * z_dim1] = 0.;
+	    z__[j + i__ * z_dim1] = 0.;
+	}
+
+	goto L290;
+
+L140:
+	i__2 = l;
+	for (k = 1; k <= i__2; ++k) {
+	    d__[k] /= scale;
+	    h__ += d__[k] * d__[k];
+	}
+
+	f = d__[l];
+	d__1 = sqrt(h__);
+	g = -d_sign(&d__1, &f);
+	e[i__] = scale * g;
+	h__ -= f * g;
+	d__[l] = f - g;
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    e[j] = 0.;
+	}
+
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    f = d__[j];
+	    z__[j + i__ * z_dim1] = f;
+	    g = e[j] + z__[j + j * z_dim1] * f;
+	    jp1 = j + 1;
+	    if (l < jp1) {
+		goto L220;
+	    }
+
+	    i__3 = l;
+	    for (k = jp1; k <= i__3; ++k) {
+		g += z__[k + j * z_dim1] * d__[k];
+		e[k] += z__[k + j * z_dim1] * f;
+	    }
+
+L220:
+	    e[j] = g;
+	}
+	f = 0.;
+
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    e[j] /= h__;
+	    f += e[j] * d__[j];
+	}
+
+	hh = f / (h__ + h__);
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    e[j] -= hh * d__[j];
+	}
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    f = d__[j];
+	    g = e[j];
+
+	    i__3 = l;
+	    for (k = j; k <= i__3; ++k) {
+		z__[k + j * z_dim1] = z__[k + j * z_dim1] - f * e[k] - g * 
+			d__[k];
+	    }
+
+	    d__[j] = z__[l + j * z_dim1];
+	    z__[i__ + j * z_dim1] = 0.;
+	}
+
+L290:
+	d__[i__] = h__;
+    }
+    i__1 = *n;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+	l = i__ - 1;
+	z__[*n + l * z_dim1] = z__[l + l * z_dim1];
+	z__[l + l * z_dim1] = 1.;
+	h__ = d__[i__];
+	if (h__ == 0.) {
+	    goto L380;
+	}
+
+	i__2 = l;
+	for (k = 1; k <= i__2; ++k) {
+	    d__[k] = z__[k + i__ * z_dim1] / h__;
+	}
+
+	i__2 = l;
+	for (j = 1; j <= i__2; ++j) {
+	    g = 0.;
+
+	    i__3 = l;
+	    for (k = 1; k <= i__3; ++k) {
+		g += z__[k + i__ * z_dim1] * z__[k + j * z_dim1];
+	    }
+
+	    i__3 = l;
+	    for (k = 1; k <= i__3; ++k) {
+		z__[k + j * z_dim1] -= g * d__[k];
+	    }
+	}
+
+L380:
+	i__3 = l;
+	for (k = 1; k <= i__3; ++k) {
+	    z__[k + i__ * z_dim1] = 0.;
+	}
+
+    }
+
+L510:
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+	d__[i__] = z__[*n + i__ * z_dim1];
+	z__[*n + i__ * z_dim1] = 0.;
+    }
+
+    z__[*n + *n * z_dim1] = 1.;
+    e[1] = 0.;
+    return 0;
+} 
+
+int tql2(integer *nm, integer *n, doublereal *d__, 
+	doublereal *e, doublereal *z__, integer *ierr)
+{
+    integer z_dim1, z_offset, i__1, i__2, i__3;
+    doublereal d__1, d__2;
+
+    double d_sign(doublereal *, doublereal *);
+
+    static doublereal c__, f, g, h__;
+    static integer i__, j, k, l, m;
+    static doublereal p, r__, s, c2, c3;
+    static integer l1, l2;
+    static doublereal s2;
+    static integer ii;
+    static doublereal dl1, el1;
+    static integer mml;
+    static doublereal tst1, tst2;
+    extern doublereal pythag_(doublereal *, doublereal *);
+
+
+
+/*     this subroutine is a translation of the algol procedure tql2, */
+/*     num. math. 11, 293-306(1968) by bowdler, martin, reinsch, and */
+/*     wilkinson. */
+/*     handbook for auto. comp., vol.ii-linear algebra, 227-240(1971). */
+
+/*     this subroutine finds the eigenvalues and eigenvectors */
+/*     of a symmetric tridiagonal matrix by the ql method. */
+/*     the eigenvectors of a full symmetric matrix can also */
+/*     be found if  tred2  has been used to reduce this */
+/*     full matrix to tridiagonal form. */
+
+/*     on input */
+
+/*        nm must be set to the row dimension of two-dimensional */
+/*          array parameters as declared in the calling program */
+/*          dimension statement. */
+
+/*        n is the order of the matrix. */
+
+/*        d contains the diagonal elements of the input matrix. */
+
+/*        e contains the subdiagonal elements of the input matrix */
+/*          in its last n-1 positions.  e(1) is arbitrary. */
+
+/*        z contains the transformation matrix produced in the */
+/*          reduction by  tred2, if performed.  if the eigenvectors */
+/*          of the tridiagonal matrix are desired, z must contain */
+/*          the identity matrix. */
+
+/*      on output */
+
+/*        d contains the eigenvalues in ascending order.  if an */
+/*          error exit is made, the eigenvalues are correct but */
+/*          unordered for indices 1,2,...,ierr-1. */
+
+/*        e has been destroyed. */
+
+/*        z contains orthonormal eigenvectors of the symmetric */
+/*          tridiagonal (or full) matrix.  if an error exit is made, */
+/*          z contains the eigenvectors associated with the stored */
+/*          eigenvalues. */
+
+/*        ierr is set to */
+/*          zero       for normal return, */
+/*          j          if the j-th eigenvalue has not been */
+/*                     determined after 30 iterations. */
+
+/*     calls pythag for  dsqrt(a*a + b*b) . */
+
+/*     questions and comments should be directed to burton s. garbow, */
+/*     mathematics and computer science div, argonne national laboratory */
+
+/*     this version dated august 1983. */
+
+/*     ------------------------------------------------------------------ */
+
+    z_dim1 = *nm;
+    z_offset = 1 + z_dim1 * 1;
+    z__ -= z_offset;
+    --e;
+    --d__;
+
+    *ierr = 0;
+    if (*n == 1) {
+	goto L1001;
+    }
+
+    i__1 = *n;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+	e[i__ - 1] = e[i__];
+    }
+
+    f = 0.;
+    tst1 = 0.;
+    e[*n] = 0.;
+
+    i__1 = *n;
+    for (l = 1; l <= i__1; ++l) {
+	j = 0;
+	h__ = (d__1 = d__[l], abs(d__1)) + (d__2 = e[l], abs(d__2));
+	if (tst1 < h__) {
+	    tst1 = h__;
+	}
+	i__2 = *n;
+	for (m = l; m <= i__2; ++m) {
+	    tst2 = tst1 + (d__1 = e[m], abs(d__1));
+	    if (tst2 == tst1) {
+		goto L120;
+	    }
+	}
+
+L120:
+	if (m == l) {
+	    goto L220;
+	}
+L130:
+	if (j == 30) {
+	    goto L1000;
+	}
+	++j;
+	l1 = l + 1;
+	l2 = l1 + 1;
+	g = d__[l];
+	p = (d__[l1] - g) / (e[l] * 2.);
+	r__ = pythag(&p, &c_b10);
+	d__[l] = e[l] / (p + d_sign(&r__, &p));
+	d__[l1] = e[l] * (p + d_sign(&r__, &p));
+	dl1 = d__[l1];
+	h__ = g - d__[l];
+	if (l2 > *n) {
+	    goto L145;
+	}
+
+	i__2 = *n;
+	for (i__ = l2; i__ <= i__2; ++i__) {
+	    d__[i__] -= h__;
+	}
+
+L145:
+	f += h__;
+	p = d__[m];
+	c__ = 1.;
+	c2 = c__;
+	el1 = e[l1];
+	s = 0.;
+	mml = m - l;
+	i__2 = mml;
+	for (ii = 1; ii <= i__2; ++ii) {
+	    c3 = c2;
+	    c2 = c__;
+	    s2 = s;
+	    i__ = m - ii;
+	    g = c__ * e[i__];
+	    h__ = c__ * p;
+	    r__ = pythag(&p, &e[i__]);
+	    e[i__ + 1] = s * r__;
+	    s = e[i__] / r__;
+	    c__ = p / r__;
+	    p = c__ * d__[i__] - s * g;
+	    d__[i__ + 1] = h__ + s * (c__ * g + s * d__[i__]);
+	    i__3 = *n;
+	    for (k = 1; k <= i__3; ++k) {
+		h__ = z__[k + (i__ + 1) * z_dim1];
+		z__[k + (i__ + 1) * z_dim1] = s * z__[k + i__ * z_dim1] + c__ 
+			* h__;
+		z__[k + i__ * z_dim1] = c__ * z__[k + i__ * z_dim1] - s * h__;
+	    }
+
+	}
+
+	p = -s * s2 * c3 * el1 * e[l] / dl1;
+	e[l] = s * p;
+	d__[l] = c__ * p;
+	tst2 = tst1 + (d__1 = e[l], abs(d__1));
+	if (tst2 > tst1) {
+	    goto L130;
+	}
+L220:
+	d__[l] += f;
+    }
+    i__1 = *n;
+    for (ii = 2; ii <= i__1; ++ii) {
+	i__ = ii - 1;
+	k = i__;
+	p = d__[i__];
+
+	i__2 = *n;
+	for (j = ii; j <= i__2; ++j) {
+	    if (d__[j] >= p) {
+		goto L260;
+	    }
+	    k = j;
+	    p = d__[j];
+L260:
+	    ;
+	}
+
+	if (k == i__) {
+	    goto L300;
+	}
+	d__[k] = d__[i__];
+	d__[i__] = p;
+
+	i__2 = *n;
+	for (j = 1; j <= i__2; ++j) {
+	    p = z__[j + i__ * z_dim1];
+	    z__[j + i__ * z_dim1] = z__[j + k * z_dim1];
+	    z__[j + k * z_dim1] = p;
+	}
+
+L300:
+	;
+    }
+
+    goto L1001;
+L1000:
+    *ierr = l;
+L1001:
+    return 0;
+}
+
+void eigen(double **mat,unsigned long n,double *eig)
+{
+  double *trans,*off;
+  int ierr,i,j,nm=(int)n;
+
+  check_alloc(trans=(double*)malloc(sizeof(double)*nm*nm));
+  check_alloc(off=(double*)malloc(sizeof(double)*nm));
+
+  tred2(&nm,&nm,&mat[0][0],eig,off,trans);
+  tql2(&nm,&nm,eig,off,trans,&ierr);
+
+  if (ierr != 0) {
+    fprintf(stderr,"Non converging eigenvalues! Exiting\n");
+    exit(EIG2_TOO_MANY_ITERATIONS);
+  }
+
+  for (i=0;i<nm;i++)
+    for (j=0;j<nm;j++)
+      mat[i][j]=trans[i+nm*j];
+
+  free(trans);
+  free(off);
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/exclude_interval.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/exclude_interval.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,39 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Apr 17, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#ifndef _MATH_H
+#include <math.h>
+#endif
+
+unsigned long exclude_interval(unsigned long n,long ex0,long ex1,
+			       unsigned long *hf,unsigned long *found)
+{
+  long i,help;
+  long lf=0;
+  
+  for (i=0;i<n;i++) {
+    help=hf[i];
+    if ((help < ex0) || (help > ex1))
+      found[lf++]=help;
+  }
+  return lf;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/find_multi_neighbors.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/find_multi_neighbors.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,59 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Jul 9, 1999 */
+#include <math.h>
+
+unsigned long find_multi_neighbors(double **s,long **box,long *list,double **x,
+			     unsigned long l,unsigned int bs,unsigned int dim,
+			     unsigned int emb,unsigned int del,double eps,
+			     unsigned long *flist)
+{
+  unsigned long nf=0;
+  int i,i1,i2,j,j1,k,k1,li;
+  int ib=bs-1;
+  long element;
+  double dx=0.0;
+  
+  i=(int)(x[0][0]/eps)&ib;
+  j=(int)(x[dim-1][0]/eps)&ib;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&ib;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&ib];
+      while (element != -1) {
+	for (k=0;k<emb;k++) {
+	  k1= -k*(int)del;
+	  for (li=0;li<dim;li++) {
+	    dx=fabs(x[li][k1]-s[li][element+k1]);
+	    if (dx > eps)
+	      break;
+	  }
+	  if (dx > eps)
+	    break;
+	}
+	if (dx <= eps)
+	  flist[nf++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nf;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/find_neighbors.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/find_neighbors.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,55 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: March 1st, 1998 */
+#include <math.h>
+
+unsigned long find_neighbors(double *s,long **box,long *list,double *x,
+			     unsigned long l,unsigned int bs,unsigned int dim,
+			     unsigned int del,double eps,unsigned long *flist)
+{
+  unsigned long nf=0;
+  int i,i1,i2,j,j1,k,k1;
+  int ib=bs-1;
+  long element;
+  double dx;
+  
+  k=(int)((dim-1)*del);
+  i=(int)(x[-k]/eps)&ib;
+  j=(int)(x[0]/eps)&ib;
+  
+  for (i1=i-1;i1<=i+1;i1++) {
+    i2=i1&ib;
+    for (j1=j-1;j1<=j+1;j1++) {
+      element=box[i2][j1&ib];
+      while (element != -1) {
+	for (k=0;k<dim;k++) {
+	  k1= -k*(int)del;
+	  dx=fabs(x[k1]-s[element+k1]);
+	  if (dx > eps)
+	    break;
+	}
+	if (k == dim)
+	  flist[nf++]=element;
+	element=list[element];
+      }
+    }
+  }
+  return nf;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/get_multi_series.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/get_multi_series.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,190 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 3, 1999 */
+/*Note: Keep in mind that the first index runs the dimension,
+  the second the time series index */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include "tsa.h"
+#include "tisean_cec.h"
+
+#define SIZE_STEP 1000
+extern void check_alloc(void*);
+
+double **get_multi_series(char *name,unsigned long *l,unsigned long ex,
+			  unsigned int *col,char *which,char colfix,
+			  unsigned int verbosity)
+{
+  char *input,**format;
+  int i,j;
+  unsigned int *hcol,maxcol=0,colcount=0;
+  unsigned long count,max_size=SIZE_STEP,hl,allcount;
+  int input_size=INPUT_SIZE;
+  double **x;
+  FILE *fin;
+
+  if (strlen(which) > 0) {
+    colcount=1;
+    for (i=0;i<strlen(which)-1;i++) {
+      if (!isdigit((unsigned int)which[i]) && (which[i] != ',')) {
+	fprintf(stderr,"Wrong format in the column string."
+		" Has to be num,num,num,...,num\n");
+	exit(GET_MULTI_SERIES_WRONG_TYPE_OF_C);
+      }
+      if (which[i] == ',') {
+	colcount++;
+	which[i]=' ';
+      }
+    }
+    if (!isdigit((unsigned int)which[strlen(which)-1])) {
+	fprintf(stderr,"Wrong format in the column string."
+		" Has to be num,num,num,...,num\n");
+	exit(GET_MULTI_SERIES_WRONG_TYPE_OF_C);
+    }      
+  }
+  if (!colfix && (*col < colcount))
+    *col=colcount;
+
+  check_alloc(input=(char*)calloc((size_t)input_size,(size_t)1));
+  check_alloc(hcol=(unsigned int*)malloc(sizeof(unsigned int)* *col));
+  while ((int)(*which) && isspace((unsigned int)(*which)))
+    which++;
+  if (*which)
+    for (i=0;i< *col-1;i++) {
+      sscanf(which,"%u",&hcol[i]);
+      if (hcol[i] > maxcol)
+	maxcol=hcol[i];
+      while ((int)(*which) && !isspace((unsigned int)(*which)))
+	which++;
+      while ((int)(*which) && isspace((unsigned int)(*which)))
+	which++;
+      if (!((int)(*which)))
+	break;
+    }
+  else
+    i= -1;
+  
+  if (*which)
+    sscanf(which,"%u",&hcol[i]);
+  else
+    for (j=i+1;j< *col;j++)
+      hcol[j]= ++maxcol;
+  
+  if (verbosity&VER_INPUT) {
+    fprintf(stderr,"Using columns: ");
+    for (i=0;i< *col;i++)
+      fprintf(stderr,"%d ",hcol[i]);
+    fprintf(stderr,"\n");
+  }
+
+  check_alloc(format=(char**)malloc(sizeof(char*)* *col));
+  for (i=0;i< *col;i++) {
+    check_alloc(format[i]=(char*)calloc((size_t)(4*hcol[i]),(size_t)1));
+    strcpy(format[i],"");
+    for (j=1;j<hcol[i];j++)
+      strcat(format[i],"%*lf");
+    strcat(format[i],"%lf");
+  }
+  free(hcol);
+  
+  check_alloc(x=(double**)malloc(sizeof(double*)* *col));
+  for (i=0;i< *col;i++)
+    check_alloc(x[i]=(double*)malloc(sizeof(double)*max_size));
+  hl= *l;
+
+  count=0;
+  allcount=0;
+  if (name == NULL) {
+    for (i=0;i<ex;i++)
+      if ((input=myfgets(input,&input_size,stdin,verbosity)) == NULL)
+	break;
+    while ((count < hl) && 
+	   ((input=myfgets(input,&input_size,stdin,verbosity)) != NULL)) {
+      if (count == max_size) {
+	max_size += SIZE_STEP;
+	for (i=0;i< *col;i++)
+	  check_alloc(x[i]=(double*)realloc(x[i],sizeof(double)*max_size));
+      }
+      allcount++;
+      for (i=0;i< *col;i++)
+	if (sscanf(input,format[i],&x[i][count]) != 1) {
+	  if (verbosity&VER_INPUT)
+	    fprintf(stderr,"Line %lu ignored: %s",allcount,input);
+	  break;
+	}
+      if (i == *col)
+	count++;
+    }
+  }
+  else {
+    fin=fopen(name,"r");
+    for (i=0;i<ex;i++)
+      if ((input=myfgets(input,&input_size,fin,verbosity)) == NULL)
+	break;
+    while ((count < hl) && 
+	   ((input=myfgets(input,&input_size,fin,verbosity)) != NULL)) {
+      if (count == max_size) {
+	max_size += SIZE_STEP;
+	for (i=0;i< *col;i++)
+	  check_alloc(x[i]=(double*)realloc(x[i],sizeof(double)*max_size));
+      }
+      allcount++;
+      for (i=0;i< *col;i++)
+	if (sscanf(input,format[i],&x[i][count]) != 1) {
+	  if (verbosity&VER_INPUT)
+	    fprintf(stderr,"Line %lu ignored: %s",allcount,input);
+	  break;
+	}
+      if ((count == 0) && (i == *col) && (verbosity&VER_FIRST_LINE)) {
+	fprintf(stderr,"get_multi_series: first data item(s) used:\n");
+	for (i=0;i< *col;i++)
+	  fprintf(stderr,"%lf ",x[i][0]);
+	fprintf(stderr,"\n");
+      }
+      if (i == *col)
+	count++;
+    }
+    fclose(fin);
+  }
+  
+  for (i=0;i< *col;i++)
+    free(format[i]);
+  free(format);
+  free(input);
+
+  *l = count;  
+  if (*l == 0) {
+    fprintf(stderr,"0 lines read. It makes no sense to continue. Exiting!\n");
+    exit(GET_MULTI_SERIES_NO_LINES);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Use %lu lines.\n",*l);
+  }
+
+  if (max_size > count)
+    for (i=0;i< *col;i++) 
+      check_alloc(x[i]=(double*)realloc(x[i],sizeof(double)*count));
+  
+  return x;
+}
+#undef SIZE_STEP
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/get_series.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/get_series.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,110 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 3, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "tsa.h"
+#include "tisean_cec.h"
+
+#define SIZE_STEP 1000
+extern void check_alloc(void*);
+
+double *get_series(char *name,unsigned long *l,unsigned long ex,
+		unsigned int col,unsigned int verbosity)
+{
+  char *input,*format;
+  int i;
+  unsigned long count,allcount,max_size=SIZE_STEP,hl;
+  int input_size=INPUT_SIZE;
+  double *x;
+  FILE *fin;
+  
+  check_alloc(input=(char*)calloc((size_t)input_size,(size_t)1));
+  check_alloc(format=(char*)calloc((size_t)(4*col),(size_t)1));
+  strcpy(format,"");
+  for (i=1;i<col;i++)
+    strcat(format,"%*lf");
+  strcat(format,"%lf");
+  
+  check_alloc(x=(double*)malloc(sizeof(double)*max_size));
+  hl= *l;
+  
+  count=0;
+  allcount=0;
+  if (name == NULL) {
+    for (i=0;i<ex;i++)
+      if ((input=myfgets(input,&input_size,stdin,verbosity)) == NULL)
+	break;
+    while ((count < hl) && 
+	   ((input=myfgets(input,&input_size,stdin,verbosity)) != NULL)) {
+      if (count == max_size) {
+	max_size += SIZE_STEP;
+	check_alloc(x=(double*)realloc(x,sizeof(double)*max_size));
+      }
+      allcount++;
+      if (sscanf(input,format,&x[count]) != 1) {
+	if (verbosity&VER_INPUT)
+	  fprintf(stderr,"Line %lu ignored: %s",allcount,input);
+      }
+      else
+	count++;
+      if ((verbosity&VER_FIRST_LINE) && (count == 0))
+	fprintf(stderr,"get_series: first data item used:\n%lf\n",x[0]);
+    }
+  }
+  else {
+    fin=fopen(name,"r");
+    for (i=0;i<ex;i++)
+      if ((input=myfgets(input,&input_size,fin,verbosity)) == NULL)
+	break;
+    while ((count < hl) && 
+	   ((input=myfgets(input,&input_size,fin,verbosity)) != NULL)) {
+      if (count == max_size) {
+	max_size += SIZE_STEP;
+	check_alloc(x=(double*)realloc(x,sizeof(double)*max_size));
+      }
+      allcount++;
+      if (sscanf(input,format,&x[count]) != 1) {
+	if (verbosity&VER_INPUT)
+	  fprintf(stderr,"Line %lu ignored: %s",allcount,input);
+      }
+      else
+	count++;
+    }
+    fclose(fin);
+  }
+  free(input);
+  
+  *l = count;
+  if (*l == 0) {
+    fprintf(stderr,"0 lines read. It makes no sense to continue. Exiting!\n");
+    exit(GET_SERIES_NO_LINES);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Use %lu lines.\n",*l);
+  }
+  if (max_size > count)
+    check_alloc(x=(double*)realloc(x,sizeof(double)*count));
+  
+  return x;
+}
+#undef SIZE_STEP
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/invert_matrix.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/invert_matrix.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,65 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/* Author: Rainer Hegger Last modified: Sep 5, 2004*/
+/* Changes: 
+ * Sep 5, 2004: added the extern check_alloc line
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+
+extern void check_alloc(void*);
+
+double **invert_matrix(double **mat,unsigned int size)
+{
+  int i,j,k;
+  double **hmat,**imat,*vec;
+  extern void solvele(double**,double*,unsigned int);
+
+  check_alloc(hmat=(double**)malloc(sizeof(double*)*size));
+  for (i=0;i<size;i++) {
+    check_alloc(hmat[i]=(double*)malloc(sizeof(double)*size));
+  }
+
+  check_alloc(imat=(double**)malloc(sizeof(double*)*size));
+  for (i=0;i<size;i++) {
+    check_alloc(imat[i]=(double*)malloc(sizeof(double)*size));
+  }
+
+  check_alloc(vec=(double*)malloc(sizeof(double)*size));
+  
+  for (i=0;i<size;i++) {
+    for (j=0;j<size;j++) {
+      vec[j]=(i==j)?1.0:0.0;
+      for (k=0;k<size;k++)
+	hmat[j][k]=mat[j][k];
+    }
+    solvele(hmat,vec,size);
+    for (j=0;j<size;j++)
+      imat[j][i]=vec[j];
+  }
+  
+  free(vec);
+  for (i=0;i<size;i++)
+    free(hmat[i]);
+  free(hmat);
+
+  return imat;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/make_box.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/make_box.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,38 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: March 1st, 1998 */
+void make_box(double *ser,long **box,long *list,unsigned long l,
+		 unsigned int bs,unsigned int dim,unsigned int del,double eps)
+{
+  int i,x,y;
+  int ib=bs-1;
+
+  for (x=0;x<bs;x++)
+    for (y=0;y<bs;y++)
+      box[x][y] = -1;
+  
+  for (i=(dim-1)*del;i<l;i++) {
+    x=(int)(ser[i-(dim-1)*del]/eps)&ib;
+    y=(int)(ser[i]/eps)&ib;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/make_multi_box.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/make_multi_box.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,39 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Jul 9, 1999 */
+void make_multi_box(double **ser,long **box,long *list,unsigned long l,
+	      unsigned int bs,unsigned int dim,unsigned int emb,
+	      unsigned int del,double eps)
+{
+  int i,x,y;
+  int ib=bs-1;
+
+  for (x=0;x<bs;x++)
+    for (y=0;y<bs;y++)
+      box[x][y] = -1;
+  
+  for (i=(emb-1)*del;i<l;i++) {
+    x=(int)(ser[0][i]/eps)&ib;
+    y=(int)(ser[dim-1][i]/eps)&ib;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/make_multi_box2.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/make_multi_box2.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,44 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger*/
+/*Changes:
+  12/11/05: first version
+*/
+
+void make_multi_box2(double **ser,long **box,long *list,unsigned long l,
+	      unsigned int bs,unsigned int dim,unsigned int emb,
+	      unsigned int del,double eps)
+{
+  int i,x,y;
+  int ib=bs-1;
+  long back=(emb-1)*del;
+
+  for (x=0;x<bs;x++)
+    for (y=0;y<bs;y++)
+      box[x][y] = -1;
+  
+  for (i=back;i<l;i++) {
+    x=(int)(ser[0][i]/eps)&ib;
+    y=(int)(ser[dim-1][i-back]/eps)&ib;
+    list[i]=box[x][y];
+    box[x][y]=i;
+  }
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/make_multi_index.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/make_multi_index.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,50 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/* Author: Rainer Hegger */
+/* Changes:
+   10/12/05: First version
+*/
+/* Comments: Parameters are no. of components of the ts, embedding
+             dimension and optionally the delay
+             return: [0][i] components, [1][i] delay
+*/
+
+#include <stdlib.h>
+
+extern void check_alloc(void *);
+
+unsigned int **make_multi_index(unsigned int comps,unsigned int emb,
+				unsigned int del)
+{
+  unsigned long i,alldim;
+  unsigned int **mmi;
+
+  alldim=comps*emb;
+  check_alloc(mmi=(unsigned int**)malloc(sizeof(unsigned int*)*2));
+  for (i=0;i<2;i++)
+    check_alloc(mmi[i]=(unsigned int*)malloc(sizeof(unsigned int)*alldim));
+
+  for (i=0;i<alldim;i++) {
+    mmi[0][i]=i%comps;
+    mmi[1][i]=(i/comps)*del;
+  }
+
+  return mmi;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/myfgets.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/myfgets.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,54 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 4, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "tsa.h"
+
+char* myfgets(char *str,int *size,FILE *fin,unsigned int verbosity)
+{
+  char *ret;
+  char *hstr=NULL;
+  char last;
+
+  ret=fgets(str,*size,fin);
+  if (ret == NULL)
+    return NULL;
+
+  last=str[strlen(str)-1];
+
+  while (last != '\n') {
+    *size += INPUT_SIZE;
+    check_alloc(hstr=(char*)calloc((size_t)INPUT_SIZE,(size_t)1));
+    check_alloc(str=realloc(str,(size_t)*size));
+    ret=fgets(hstr,INPUT_SIZE,fin);
+    strcat(str,hstr);
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Line in file too long. Increasing input size\n");
+    last=str[strlen(str)-1];
+    free(hstr);
+  }
+
+  if (ret == NULL)
+    return NULL;
+  else
+    return str;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/rand.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/rand.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,157 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Feb 12, 2006 */
+/* Changes:
+   Sep 5, 2004 : add extern definition of check_alloc
+   Feb 12, 2006: add was_set to avoid multiple initialisations
+*/
+
+#define __RANDOM
+
+#ifndef	_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifndef _LIMITS_H
+#include <limits.h>
+#endif
+
+#ifndef _MATH_H
+#include <math.h>
+#endif
+
+
+#ifndef M_PI
+#define M_PI 3.1415926535897932385E0
+#endif
+
+extern void check_alloc(void*);
+
+static unsigned long *rnd_array,rnd69,*rnd1279,factor;
+static unsigned long *nexti,rndtime,rndtime1,rndtime2,rndtime3,*next1279;
+static unsigned long t1279,t1279_1,t1279_2,t1279_3;
+static double lo_limit;
+static char rnd_init_was_set=0;
+
+void rnd_init(unsigned long iseed)
+{
+  int i;
+  unsigned long z,index;
+
+  if (rnd_init_was_set == 1)
+    return ;
+
+  rnd_init_was_set=1;
+
+  if (sizeof(long) == 8) {
+    factor=13*13*13*13;
+    factor=factor*factor*factor*13;
+  }
+  else
+    factor=69069;
+  lo_limit=(double)ULONG_MAX;
+
+  check_alloc(rnd_array=(unsigned long *)malloc(9689*sizeof(unsigned long)));
+  check_alloc(nexti=(unsigned long *)malloc(9689*sizeof(long)));
+  check_alloc(rnd1279=(unsigned long *)malloc(1279*sizeof(unsigned long)));
+  check_alloc(next1279=(unsigned long *)malloc(1279*sizeof(long)));
+
+  rnd_array[0]=rnd1279[0]=iseed;
+  rnd69=iseed;
+  index=iseed;
+  nexti[0]=next1279[0]=1;
+
+  for (i=1;i<9689;i++) {
+    rnd_array[i]=factor*rnd_array[i-1]+1;
+    nexti[i]=i+1;
+  }
+
+  for (i=1;i<1279;i++) {
+    rnd1279[i]=factor*rnd1279[i-1]+1;
+    next1279[i]=i+1;
+  }
+  nexti[9688]=next1279[1278]=0;
+
+  for (i=1;i<2000;i++) {
+    index=factor*index+1;
+    z=rnd1279[((index>>10)%1279)];
+    z=(z<<10)+(z>>10);
+    index=factor*index+1;
+    rnd1279[((index>>10)%1279)] += z;
+  }
+
+  nexti[9688]=next1279[1278]=0;
+  rndtime=9688;
+  rndtime1=9688-157;
+  rndtime2=9688-314;
+  rndtime3=9688-471;
+  t1279=1278;
+  t1279_1=1278-216;
+  t1279_2=1278-299;
+  t1279_3=1278-598;
+}
+
+unsigned long rnd_long(void)
+{
+  rndtime=nexti[rndtime];
+  rndtime1=nexti[rndtime1];
+  rndtime2=nexti[rndtime2];
+  rndtime3=nexti[rndtime3];
+  rnd_array[rndtime] ^= rnd_array[rndtime1]
+    ^rnd_array[rndtime2]^rnd_array[rndtime3];
+
+  return rnd_array[rndtime];
+}
+
+unsigned long rnd_1279(void)
+{
+  t1279=next1279[t1279];
+  t1279_1=next1279[t1279_1];
+  t1279_2=next1279[t1279_2];
+  t1279_3=next1279[t1279_3];
+
+  rnd1279[t1279] += (rnd1279[t1279_1] + rnd1279[t1279_2] 
+		     + rnd1279[t1279_3]);
+  return rnd1279[t1279];
+}
+
+unsigned long rnd69069(void)
+{
+  return (rnd69=rnd69*factor+1);
+}
+
+double gaussian(double sigma)
+{
+  static unsigned long gausscount=0;
+  double x,r,u,phi;
+  static double y;
+  
+  if (!(gausscount++ & 0x1)) {
+    phi=2.0*M_PI*(double)rnd_1279()/lo_limit;
+    u=(double)rnd_1279()/lo_limit;
+    r=sqrt(-2.0*sigma*sigma*log(u));
+    x=r*cos(phi);
+    y=r*sin(phi);
+
+    return x;
+  }
+  else
+    return y;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/rand_arb_dist.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/rand_arb_dist.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,94 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Feb 11, 2006 */
+/*Changes:
+  Feb 11, 2006: First version
+*/
+/*Comment:
+  Creates a sequence of random numbers with arbitrary distribution
+  Input Paramters: x=original data defining the distribution
+                   nx= length of x
+                   nc= number of random numbers to create
+                   nb= number of bins for the distribution
+		   iseed = seed for the random number generator
+  Return: rand = array containing the nc random numbers
+*/
+
+#ifndef _STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifndef _LIMITS_H
+#include <limits.h>
+#endif
+
+#ifndef _TIME_H
+#include <time.h>
+#endif
+
+extern void rescale_data(double*,unsigned long,double*,double*);
+extern void check_alloc(void*);
+extern unsigned long rnd_long(void);
+extern void  rnd_init(unsigned long);
+
+double *rand_arb_dist(double *x,unsigned long nx,unsigned long nc,
+		      unsigned int nb,unsigned long iseed)
+{
+  double h,min,inter,*randarb,drnd,epsinv=1.0/(double)nb;
+  unsigned long i,j,*box,hrnd,nall=nx+nb;
+
+  rescale_data(x,nx,&min,&inter);
+
+  check_alloc(box=(unsigned long*)malloc(sizeof(unsigned long)*nb));
+  for (i=0;i<nb;i++)
+    box[i]=1;
+
+  for (i=0;i<nx;i++) {
+    h=x[i];
+    if (h >= 1.0) 
+      h -= epsinv/2.0;
+    j=(unsigned int)(h*nb);
+    box[j]++;
+  }
+  for (i=1;i<nb;i++)
+    box[i] += box[i-1];
+
+  check_alloc(randarb=(double*)malloc(sizeof(double)*nc));
+
+  if (iseed == 0)
+    iseed=(unsigned long)time((time_t*)&iseed);
+
+  rnd_init(iseed);
+  for (i=0;i<1000;i++)
+    rnd_long();
+
+  for (i=0;i<nc;i++) {
+    hrnd=rnd_long()%nall;
+    for (j=0;j<nb;j++)
+      if (box[j] >= hrnd)
+	break;
+    drnd=(double)rnd_long()/(double)ULONG_MAX*epsinv;
+    randarb[i]=min+((double)j*epsinv+drnd)*inter;
+  }
+
+  free(box);
+
+  return randarb;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/rescale_data.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/rescale_data.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,50 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 5, 2004*/
+/* Changes: 
+ * Sep 5 2004: + include <stdlib.h>
+ */
+
+#include <stdio.h>
+#include "tisean_cec.h"
+#include <stdlib.h>
+
+void rescale_data(double *x,unsigned long l,double *min,double *interval)
+{
+  int i;
+  
+  *min=*interval=x[0];
+  
+  for (i=1;i<l;i++) {
+    if (x[i] < *min) *min=x[i];
+    if (x[i] > *interval) *interval=x[i];
+  }
+  *interval -= *min;
+
+  if (*interval != 0.0) {
+    for (i=0;i<l;i++)
+      x[i]=(x[i]- *min)/ *interval;
+  }
+  else {
+    fprintf(stderr,"rescale_data: data ranges from %e to %e. It makes\n"
+	    "\t\tno sense to continue. Exiting!\n\n",*min,*min+(*interval));
+    exit(RESCALE_DATA_ZERO_INTERVAL);
+  }
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/scan_help.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/scan_help.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,33 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: March 29th, 1998 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+int scan_help(int n,char **in)
+{
+  int i;
+  
+  for (i=1;i<n;i++)
+    if ((in[i][0] == '-') && (in[i][1] == 'h'))
+      return 1;
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/search_datafile.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/search_datafile.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,125 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 3, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include "tsa.h"
+
+char check_col(char *col)
+{
+  int i;
+  
+  for (i=0;i<strlen(col);i++)
+    if (!isdigit((unsigned int)col[i])) {
+      fprintf(stderr,"Column must be a unsigned integer. Ignoring it!\n");
+      return 0;
+    }
+  return 1;
+}
+
+char look_for_column(char *name,unsigned int *col)
+{
+  char *hcol,*hname;
+  char vcol=0;
+  int j,in;
+
+  check_alloc(hname=(char*)calloc(strlen(name)+1,1));
+  check_alloc(hcol=(char*)calloc(strlen(name)+1,1));
+  j=0;
+  while (*(name+j) != '\0') {
+    if (*(name+j) == ',') {
+      in=sscanf(name+j+1,"%s",hcol);
+      if (in > 0)
+	vcol=check_col(hcol);
+      *(name+j)='\0';
+      break;
+    }
+    *(hname+j)=*(name+j);
+    j++;
+  }
+  *col=(unsigned int)atoi(hcol);
+  free(hname);
+  free(hcol);
+
+  return vcol;
+}
+
+char* search_datafile(int n,char **names,unsigned int *col,
+		      unsigned int verbosity)
+{
+  char valid=0,validcol=0;
+  char *retname=NULL;
+  int i;
+  unsigned int hcol;
+  FILE *test;
+
+  for (i=n-1;i>0;i--) {
+    if (names[i] != NULL) {
+      valid=0;
+      if (strcmp(names[i],"-")) {
+	if (col != 0)
+	  validcol=look_for_column(names[i],&hcol);
+	test=fopen(names[i],"r");
+	if (test == NULL) {
+	  fprintf(stderr,"File %s not found!\n",names[i]);
+	}
+	else {
+	  fclose(test);
+	  if ((col != 0) && (validcol == 1))
+	    *col=hcol;
+	  if (col != 0) {
+	    if (verbosity&VER_INPUT)
+	      fprintf(stderr,"Using %s as datafile, reading column %u\n",
+		      names[i],*col);
+	  }
+	  else {
+	    if (verbosity&VER_INPUT)
+	      fprintf(stderr,"Using %s as datafile!\n",names[i]);
+	  }
+	  check_alloc(retname=(char*)calloc(strlen(names[i])+1,(size_t)1));
+	  strcpy(retname,names[i]);
+	  names[i]=NULL;
+	  return retname;
+	}
+      }
+      else {
+	valid=1;
+	break;
+      }
+    }
+  }
+
+  if (valid == 1) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Reading input from stdin!\n");
+    return NULL;
+  }
+  
+  if (verbosity&VER_INPUT) {
+    if ((col != 0) && (validcol == 1))
+      fprintf(stderr,"Reading input from stdin, using column %u!\n",*col);
+    else
+      fprintf(stderr,"Reading input from stdin!\n");
+  }
+
+  return NULL;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/solvele.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/solvele.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,69 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/* Author: Rainer Hegger Last modified: Aug 14th, 1998 */
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include "tisean_cec.h"
+
+void solvele(double **mat,double *vec,unsigned int n)
+{
+  double vswap,*mswap,*hvec,max,h,pivot,q;
+  int i,j,k,maxi;
+
+  for (i=0;i<n-1;i++) {
+    max=fabs(mat[i][i]);
+    maxi=i;
+    for (j=i+1;j<n;j++)
+      if ((h=fabs(mat[j][i])) > max) {
+	max=h;
+	maxi=j;
+      }
+    if (maxi != i) {
+      mswap=mat[i];
+      mat[i]=mat[maxi];
+      mat[maxi]=mswap;
+      vswap=vec[i];
+      vec[i]=vec[maxi];
+      vec[maxi]=vswap;
+    }
+    
+    hvec=mat[i];
+    pivot=hvec[i];
+    if (fabs(pivot) == 0.0) {
+      fprintf(stderr,"Singular matrix! Exiting!\n");
+      exit(SOLVELE_SINGULAR_MATRIX);
+    }
+    for (j=i+1;j<n;j++) {
+      q= -mat[j][i]/pivot;
+      mat[j][i]=0.0;
+      for (k=i+1;k<n;k++)
+	mat[j][k] += q*hvec[k];
+      vec[j] += q*vec[i];
+    }
+  }
+  vec[n-1] /= mat[n-1][n-1];
+  for (i=n-2;i>=0;i--) {
+    hvec=mat[i];
+    for (j=n-1;j>i;j--)
+      vec[i] -= hvec[j]*vec[j];
+    vec[i] /= hvec[i];
+  }
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/test_outfile.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/test_outfile.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,35 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Mar 20, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include "tisean_cec.h"
+
+void test_outfile(char *name)
+{
+  FILE *file;
+  
+  file=fopen(name,"a");
+  if (file == NULL) {
+    fprintf(stderr,"Couldn't open %s for writing. Exiting\n",name);
+    exit(TEST_OUTFILE_NO_WRITE_ACCESS);
+  }
+  fclose(file);
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/tisean_cec.h
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/tisean_cec.h	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,85 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: May 26, 2000*/
+
+/* These definitions give the exit codes for the C part of the Tisean package.
+   Typically the name is build up of, first, the name of the routine creating
+   the exception, secondly, sort of an description of the exception.
+   */
+
+#ifndef _TISEAN_CEC_H
+#define _TISEAN_CEC_H
+
+/* These are the codes for the routines subtree */
+#define RESCALE_DATA_ZERO_INTERVAL 11
+#define CHECK_ALLOC_NOT_ENOUGH_MEMORY 12
+#define CHECK_OPTION_NOT_UNSIGNED 13
+#define CHECK_OPTION_NOT_INTEGER 14
+#define CHECK_OPTION_NOT_FLOAT 15
+#define CHECK_OPTION_NOT_TWO 16
+#define CHECK_OPTION_C_NO_VALUE 17
+#define TEST_OUTFILE_NO_WRITE_ACCESS 18
+#define SOLVELE_SINGULAR_MATRIX 19
+#define GET_SERIES_NO_LINES 20
+#define GET_MULTI_SERIES_WRONG_TYPE_OF_C 21
+#define GET_MULTI_SERIES_NO_LINES 22
+#define VARIANCE_VAR_EQ_ZERO 23
+#define EIG2_TOO_MANY_ITERATIONS 24
+#define CHECK_OPTION_NOT_THREE 25
+
+/* These are the codes for the main routines */
+#define LYAP_SPEC_NOT_ENOUGH_NEIGHBORS 50
+#define LYAP_SPEC_DATA_TOO_SHORT 51
+#define AR_MODEL_TOO_MANY_POLES 52
+#define EXTREMA_STRANGE_COMPONENT 53
+#define FALSE_NEAREST_NOT_ENOUGH_POINTS 54
+#define FSLE__TOO_LARGE_MINEPS 55
+#define GHKSS__TOO_MANY_NEIGHBORS 56
+#define NSTAT_Z__INVALID_STRING_FOR_OPTION 57
+#define NSTAT_Z__NOT_UNSIGNED_FOR_OPTION 58
+#define NSTAT_Z__TOO_LARGE_FOR_OPTION 59
+#define NSTAT_Z__OPTION_NOT_SET 60
+#define NSTAT_Z__TOO_MANY_PIECES 61
+#define NSTEP__ESCAPE_REGION 62
+#define POINCARE__WRONG_COMPONENT 63
+#define POINCARE__OUTSIDE_REGION 64
+#define POLYBACK__WRONG_PARAMETER_FILE 65
+#define POLYNOMP__WRONG_PARAMETER_FILE 66
+#define RESCALE__WRONG_INTERVAL 67
+#define SAV_GOL__UNDERDETERMINED 68
+#define SAV_GOL__TOO_LARGE_DERIVATIVE 69
+#define MAKENOISE__FLAGS_REQUIRED 70
+#define ZEROTH__STEP_TOO_LARGE 71
+#define LYAP_K__MAXITER_TOO_LARGE 72
+#define DELAY_WRONG_FORMAT_F 73
+#define DELAY_DIM_NOT_EQUAL_F_M 74
+#define DELAY_DIM_NOT_EQUAL_F_m 75
+#define DELAY_WRONG_FORMAT_D 76
+#define DELAY_WRONG_NUM_D 77
+#define DELAY_INCONS_d_D 78
+#define DELAY_SMALL_ZERO 79
+#define DELAY_INCONS_m_M 80
+#define ONESTEP_TOO_FEW_POINTS 81
+#define MEM_SPEC_TOO_MANY_POLES 82
+
+/* Global stuff */
+#define VECTOR_TOO_LARGE_FOR_LENGTH 100
+
+#endif
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/tsa.h
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/tsa.h	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,105 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: Sep 3, 1999 */
+
+#ifndef _TSA_ROUTINES_H
+#define _TSA_ROUTINES_H
+
+#ifndef _TISEAN_CEC_H
+#include "tisean_cec.h"
+#endif
+
+/* size of the string which reads the input data
+   if your lines are longer than some 500 reals, increase the value
+   */
+#define INPUT_SIZE 1024
+
+/* The possible names of the verbosity levels */
+#define VER_INPUT 0x1
+#define VER_USR1 0x2
+#define VER_USR2 0x4
+#define VER_USR3 0x8
+#define VER_USR4 0x10
+#define VER_USR5 0x20
+#define VER_USR6 0x40
+#define VER_FIRST_LINE 0x80
+
+/* Uncomment the variable to get rid of the initial Version message */
+/*#define OMIT_WHAT_I_DO*/
+
+#define sqr(x) ((x)*(x))
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern int scan_help(int,char**);
+extern double *get_series(char *,unsigned long *,unsigned long,
+		       unsigned int,unsigned int);
+extern double **get_multi_series(char *,unsigned long *,unsigned long,
+				 unsigned int *,char *,char,unsigned int);
+extern void rescale_data(double *,unsigned long,double *,double *);
+extern void variance(double *,unsigned long,double *,double *);
+extern void make_box(double *,long **,long *,unsigned long,
+			unsigned int,unsigned int,unsigned int,double);
+extern unsigned long find_neighbors(double *,long **,long *,double *,
+				    unsigned long,unsigned int,unsigned int,
+				    unsigned int,double,unsigned long *);
+extern char* search_datafile(int, char**,unsigned int*,unsigned int);
+extern char* check_option(char**,int,int,int);
+extern void  solvele(double**,double *,unsigned int);
+extern void test_outfile(char*);
+extern double** invert_matrix(double**,unsigned int);
+extern unsigned long exclude_interval(unsigned long,long,long,
+				      unsigned long*,unsigned long*);
+extern void make_multi_box(double **,long **,long *,unsigned long,
+			   unsigned int,unsigned int,unsigned int,
+			   unsigned int,double);
+  /*only used for nrlazy. Will be removed with nrlazy */
+extern void make_multi_box2(double **,long **,long *,unsigned long,
+			   unsigned int,unsigned int,unsigned int,
+			   unsigned int,double);
+extern unsigned long find_multi_neighbors(double **,long **,long *,double **,
+					  unsigned long,unsigned int,
+					  unsigned int,unsigned int,
+					  unsigned int,double,unsigned long *);
+extern unsigned int** make_multi_index(unsigned int,unsigned int,unsigned int);
+
+extern void check_alloc(void *);
+extern char* myfgets(char *,int *,FILE *,unsigned int);
+extern void what_i_do(char *, char *);
+extern double* rand_arb_dist(double *,unsigned long,unsigned long,
+			     unsigned int,unsigned long);
+
+/* routines from rand.c */
+extern void rnd_init(unsigned long);
+extern unsigned long rnd_long();
+extern unsigned long rnd_1279();
+extern unsigned long rnd69069();
+extern double gaussian(double);
+
+/* routines from eigen.c */
+extern void eigen(double**,unsigned long,double*);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/variance.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/variance.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,45 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger Last modified: May 23th, 1998 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include "tisean_cec.h"
+
+void variance(double *s,unsigned long l,double *av,double *var)
+{
+  unsigned long i;
+  double h;
+  
+  *av= *var=0.0;
+
+  for (i=0;i<l;i++) {
+    h=s[i];
+    *av += h;
+    *var += h*h;
+  }
+  *av /= (double)l;
+  *var=sqrt(fabs((*var)/(double)l-(*av)*(*av)));
+  if (*var == 0.0) {
+    fprintf(stderr,"Variance of the data is zero. Exiting!\n\n");
+    exit(VARIANCE_VAR_EQ_ZERO);
+  }
+}
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/routines/what_i_do.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/routines/what_i_do.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,31 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Thomas Schreiber Last modified: 2.Sep, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+
+void what_i_do(char *name,char *text)
+{
+  fprintf(stderr, "\nTISEAN 3.0.1 (C) R. Hegger, H. Kantz,"
+                  " T. Schreiber (1998-2007)\n\n"
+     "%s: %s\n\n",name,text);
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/sav_gol.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/sav_gol.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,257 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified May 27, 2000 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Savitzky-Golay filter: Filters the data or estimates\n\t\
+filtered derivatives, respectively."
+
+unsigned long length=ULONG_MAX,exclude=0;
+unsigned int dim=1;
+char dimset=0;
+char *columns=NULL;
+unsigned int nf=2,nb=2,power=2,deriv=0;
+char *infile=NULL,*outfile=NULL,stdo=1;
+unsigned int verbosity=(VER_INPUT|VER_FIRST_LINE);
+
+double **series;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr,"  Usage: %s [options]\n",progname);
+  fprintf(stderr,"  Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l datapoints [default is whole file]\n");
+  fprintf(stderr,"\t-x exclude # points [default %ld]\n",exclude);
+  fprintf(stderr,"\t-c columns [default 1]\n");
+  fprintf(stderr,"\t-m no. of components [default %d]\n",dim);
+  fprintf(stderr,"\t-n nb,nf [default %u,%u]\n",nb,nf);
+  fprintf(stderr,"\t-p power of the polynomial [default %u]\n",power);
+  fprintf(stderr,"\t-D order of the estimated derivative [default %u]\n",deriv);
+  fprintf(stderr," \t-o outfile [default 'datafile'.sg; Without -o data"
+	  " is written to stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int n,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,n,'c','s')) != NULL)
+    columns=out;
+  if ((out=check_option(argv,n,'m','u')) != NULL) {
+    sscanf(out,"%u",&dim);
+    dimset=1;
+  }
+  if ((out=check_option(argv,n,'n','2')) != NULL)
+    sscanf(out,"%u,%u",&nb,&nf);
+  if ((out=check_option(argv,n,'p','u')) != NULL)
+    sscanf(out,"%u",&power);
+  if ((out=check_option(argv,n,'D','u')) != NULL)
+    sscanf(out,"%u",&deriv);
+  if ((out=check_option(argv,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double** make_coeff(void)
+{
+  long i,j,k;
+  double **mat,**imat,**rmat;
+  
+  check_alloc(mat=(double**)malloc(sizeof(double*)*(power+1)));
+  for (i=0;i<=power;i++)
+    check_alloc(mat[i]=(double*)malloc(sizeof(double)*(power+1)));
+  check_alloc(rmat=(double**)malloc(sizeof(double*)*(power+1)));
+  for (i=0;i<=power;i++)
+    check_alloc(rmat[i]=(double*)malloc(sizeof(double)*(nb+nf+1)));
+  
+  for (i=0;i<=power;i++)
+    for (j=0;j<=power;j++) {
+      mat[i][j]=0.0;
+      for (k= -(int)nb;k<=(int)nf;k++)
+	mat[i][j] += pow((double)k,(double)(i+j));
+    }
+
+  imat=invert_matrix(mat,(power+1));
+  
+  for (i=0;i<=power;i++)
+    for (j=0;j<=(nb+nf);j++) {
+      rmat[i][j]=0.0;
+      for (k=0;k<=power;k++)
+	rmat[i][j] += imat[i][k]*pow((double)(j-(int)nb),(double)k);
+    }
+  
+  for (i=0;i<=power;i++) {
+    free(mat[i]);
+    free(imat[i]);
+  }
+  free(mat);
+  free(imat);
+
+  return rmat;
+}
+
+double make_norm(void)
+{
+  double ret=1.0;
+  long i;
+
+  for (i=2;i<=deriv;i++)
+    ret *= (double)i;
+
+  return 1.0/ret;
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  long i,j,d;
+  double **coeff,help,norm;
+  FILE *fout;
+
+  if (scan_help(argc,argv)) 
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+
+  if (power >= (nb+nf+1)) {
+    fprintf(stderr,"With these settings for the -n and -p flags,\nthe"
+	    " system is underdetermined. Exiting\n\n");
+    exit(SAV_GOL__UNDERDETERMINED);
+  }
+  if (deriv > power) {
+    fprintf(stderr,"The order of the derivative must not be larger\nthan"
+	    " the power of polynomial. Exiting\n\n");
+    exit(SAV_GOL__TOO_LARGE_DERIVATIVE);
+  }
+
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,NULL,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+4,(size_t)1));
+      sprintf(outfile,"%s.sg",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)9,(size_t)1));
+      sprintf(outfile,"stdin.sg");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (columns == NULL)
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,"",
+				      dimset,verbosity);
+  else
+    series=(double**)get_multi_series(infile,&length,exclude,&dim,
+				      columns,dimset,verbosity);
+  
+  coeff=make_coeff();
+  norm=make_norm();
+
+  if (stdo) {
+    for (i=0;i<nb;i++) {
+      for (d=0;d<dim;d++)
+	fprintf(stdout,"%e ",(deriv==0)?series[d][i]:0.0);
+      fprintf(stdout,"\n");
+    }
+    for (i=(long)nb;i<length-(long)nf;i++) {
+      for (d=0;d<dim;d++) {
+	help=0.0;
+	for (j= -(long)nb;j<=(long)nf;j++)
+	  help += coeff[deriv][j+nb]*series[d][i+j];
+	fprintf(stdout,"%e ",help*norm);
+      }
+      fprintf(stdout,"\n");
+    }
+    for (i=length-(long)nf;i<length;i++) {
+      for (d=0;d<dim;d++)
+	fprintf(stdout,"%e ",(deriv==0)?series[d][i]:0.0);
+      fprintf(stdout,"\n");
+    }
+  }
+  else {
+    fout=fopen(outfile,"w");
+    for (i=0;i<nb;i++) {
+      for (d=0;d<dim;d++)
+	fprintf(fout,"%e ",(deriv==0)?series[d][i]:0.0);
+      fprintf(fout,"\n");
+    }
+    for (i=(long)nb;i<length-(long)nf;i++) {
+      for (d=0;d<dim;d++) {
+	help=0.0;
+	for (j= -(long)nb;j<=(long)nf;j++)
+	  help += coeff[deriv][j+nb]*series[d][i+j];
+	fprintf(fout,"%e ",help*norm);
+      }
+      fprintf(fout,"\n");
+    }
+    for (i=length-(long)nf;i<length;i++) {
+      for (d=0;d<dim;d++)
+	fprintf(fout,"%e ",(deriv==0)?series[d][i]:0.0);
+      fprintf(fout,"\n");
+    }
+    fclose(fout);
+  }
+
+  for (i=0;i<dim;i++)
+    free(series[i]);
+  free(series);
+  free(outfile);
+  if (!stdi)
+    free(infile);
+  for (i=0;i<=power;i++)
+    free(coeff[i]);
+  free(coeff);
+
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/xcor.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/xcor.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,186 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 4, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+#include <limits.h>
+#include <string.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the crosscorrelations of two data sets\n\t\
+given as two columns of one file."
+
+char *columns=NULL,*outfile=NULL,stout=1;
+unsigned long length=ULONG_MAX,exclude=0;
+long tau=100;
+unsigned int verbosity=0xff;
+double *array1,*array2;
+char *infile=NULL;
+
+void show_options(char *progname) 
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [Options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l length [default is whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default 0]\n");
+  fprintf(stderr,"\t-c which columns (separated by commas) [default is 1,2]\n");
+  fprintf(stderr,"\t-D corrlength  [default is 100]\n");
+  fprintf(stderr,"\t-o output_file  [default is 'datafile'.crc; no -o"
+  " means stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default is 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  fprintf(stderr,"\n");
+  exit(0);
+}
+
+void scan_options(int argc,char **argv)
+{
+  char *out;
+
+  if ((out=check_option(argv,argc,'l','u')) != NULL)
+    sscanf(out,"%lu",&length);
+  if ((out=check_option(argv,argc,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(argv,argc,'c','s')) != NULL)
+    columns=out;
+  if ((out=check_option(argv,argc,'D','u')) != NULL)
+    sscanf(out,"%ld",&tau);
+  if ((out=check_option(argv,argc,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(argv,argc,'o','o')) != NULL) {
+    stout=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double corr(long i)
+{
+  unsigned long count=0;
+  long j,hi;
+  double c=0.0;
+  
+  for (j=0;j<length;j++) {
+    hi=j+i;
+    if ((hi >= 0) && (hi < length)) {
+      count++;
+      c += array1[j]*array2[hi];
+    }
+  }
+  return c/(double)count;
+}
+
+int main(int argc,char** argv)
+{
+  char stdi=0;
+  long i;
+  unsigned int dummy=2;
+  FILE *fout=NULL;
+  double **both;
+  double av1,var1,av2,var2;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,0L,verbosity);
+  if (infile == NULL)
+    stdi=1;
+  
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      strcpy(outfile,infile);
+      strcat(outfile,".ccr");
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      strcpy(outfile,"stdin.ccr");
+    }
+  }
+  if (!stout)
+    test_outfile(outfile);
+
+  if (columns == NULL)
+    both=(double**)get_multi_series(infile,&length,exclude,&dummy,"",(char)1,
+				    verbosity);
+  else
+    both=(double**)get_multi_series(infile,&length,exclude,&dummy,columns,
+				    (char)1,verbosity);
+    
+  array1=both[0];
+  array2=both[1];
+
+  if (tau >= length)
+    tau=length-1;
+
+  variance(array1,length,&av1,&var1);
+  variance(array2,length,&av2,&var2);
+  
+  for (i=0;i<length;i++) {
+    array1[i] -= av1;
+    array2[i] -= av2;
+  }
+
+  if (!stout) {
+    fout=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    fprintf(fout,"# average of first comp.=%e\n",av1);
+    fprintf(fout,"# standard deviation of first comp.=%e\n",var1);
+    fprintf(fout,"# average of sec. comp.=%e\n",av2);
+    fprintf(fout,"# standard deviation of sec. comp.=%e\n",var2);
+  }
+  else {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    fprintf(stdout,"# average of first comp.=%e\n",av1);
+    fprintf(stdout,"# standard deviation of first comp.=%e\n",var1);
+    fprintf(stdout,"# average of sec. comp.=%e\n",av2);
+    fprintf(stdout,"# standard deviation of sec. comp.=%e\n",var2);
+  }
+
+  for (i= -tau;i<=tau;i++)
+    if (!stout) {
+      fprintf(fout,"%ld %e\n",i,corr(i)/var1/var2);
+      fflush(fout);
+    }
+    else {
+      fprintf(stdout,"%ld %e\n",i,corr(i)/var1/var2);
+      fflush(stdout);
+    }
+  if (!stout)
+    fclose(fout);
+  
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_c/xzero.c
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_c/xzero.c	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,237 @@
+/*
+ *   This file is part of TISEAN
+ *
+ *   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+ *
+ *   TISEAN 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.
+ *
+ *   TISEAN 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 TISEAN; if not, write to the Free Software
+ *   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+/*Author: Rainer Hegger. Last modified: Sep 4, 1999 */
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <limits.h>
+#include "routines/tsa.h"
+
+#define WID_STR "Estimates the average cross forecast error for a zeroth\n\t\
+order fit between two series given as two columns of one file."
+
+#ifndef _MATH_H
+#include <math.h>
+#endif
+
+/*number of boxes for the neighbor search algorithm*/
+#define NMAX 128
+
+unsigned int nmax=(NMAX-1);
+long **box,*list;
+unsigned long *found;
+double *series1,*series2;
+double interval,min,epsilon;
+
+char epsset=0;
+char *infile=NULL;
+char *outfile=NULL,stdo=1;
+char *COLUMNS=NULL;
+unsigned int DIM=3,DELAY=1;
+unsigned int verbosity=0xff;
+int MINN=30,STEP=1;
+double EPS0=1.e-3,EPSF=1.2;
+unsigned long LENGTH=ULONG_MAX,exclude=0,CLENGTH=ULONG_MAX;
+
+void show_options(char *progname)
+{
+  what_i_do(progname,WID_STR);
+  fprintf(stderr," Usage: %s [options]\n",progname);
+  fprintf(stderr," Options:\n");
+  fprintf(stderr,"Everything not being a valid option will be interpreted"
+          " as a possible"
+          " datafile.\nIf no datafile is given stdin is read. Just - also"
+          " means stdin\n");
+  fprintf(stderr,"\t-l # of data to use [default: whole file]\n");
+  fprintf(stderr,"\t-x # of lines to be ignored [default: 0]\n");
+  fprintf(stderr,"\t-c columns to read [default: 1,2]\n");
+  fprintf(stderr,"\t-m embedding dimension [default: 3]\n");
+  fprintf(stderr,"\t-d delay [default: 1]\n");
+  fprintf(stderr,"\t-n # of reference points [default: length]\n");
+  fprintf(stderr,"\t-k minimal number of neighbors for the fit "
+	  "[default: 30]\n");
+  fprintf(stderr,"\t-r neighborhoud size to start with "
+	  "[default: (data interval)/1000]\n");
+  fprintf(stderr,"\t-f factor to increase size [default: 1.2]\n");
+  fprintf(stderr,"\t-s steps to forecast [default: 1]\n");
+  fprintf(stderr,"\t-o output file [default: 'datafile.cze',"
+	  " without -o: stdout]\n");
+  fprintf(stderr,"\t-V verbosity level [default: 1]\n\t\t"
+          "0='only panic messages'\n\t\t"
+          "1='+ input/output messages'\n");
+  fprintf(stderr,"\t-h show these options\n");
+  exit(0);
+}
+
+void scan_options(int n,char **in)
+{
+  char *out;
+
+  if ((out=check_option(in,n,'l','u')) != NULL)
+    sscanf(out,"%lu",&LENGTH);
+  if ((out=check_option(in,n,'x','u')) != NULL)
+    sscanf(out,"%lu",&exclude);
+  if ((out=check_option(in,n,'c','s')) != NULL)
+    COLUMNS=out;
+  if ((out=check_option(in,n,'m','u')) != NULL)
+    sscanf(out,"%u",&DIM);
+  if ((out=check_option(in,n,'d','u')) != NULL)
+    sscanf(out,"%u",&DELAY);
+  if ((out=check_option(in,n,'n','u')) != NULL)
+    sscanf(out,"%lu",&CLENGTH);
+  if ((out=check_option(in,n,'k','u')) != NULL)
+    sscanf(out,"%u",&MINN);
+  if ((out=check_option(in,n,'r','f')) != NULL) {
+    epsset=1;
+    sscanf(out,"%lf",&EPS0);
+  }
+  if ((out=check_option(in,n,'f','f')) != NULL)
+    sscanf(out,"%lf",&EPSF);
+  if ((out=check_option(in,n,'s','u')) != NULL)
+    sscanf(out,"%u",&STEP);
+  if ((out=check_option(in,n,'V','u')) != NULL)
+    sscanf(out,"%u",&verbosity);
+  if ((out=check_option(in,n,'o','o')) != NULL) {
+    stdo=0;
+    if (strlen(out) > 0)
+      outfile=out;
+  }
+}
+
+double make_fit(unsigned long act,unsigned long number,unsigned long istep)
+{
+  double casted=0.0;
+  int i;
+  
+  for (i=0;i<number;i++)
+    casted += series1[found[i]+istep];
+  casted /= number;
+
+  return (casted-series2[act+istep])*(casted-series2[act+istep]);
+}
+
+int main(int argc,char **argv)
+{
+  char stdi=0;
+  char alldone,*done;
+  unsigned long i,j,actfound;
+  unsigned long clength;
+  unsigned int dummy=2;
+  double rms2,av2,*error;
+  double **both,hinter;
+  FILE *file;
+
+  if (scan_help(argc,argv))
+    show_options(argv[0]);
+  
+  scan_options(argc,argv);
+#ifndef OMIT_WHAT_I_DO
+  if (verbosity&VER_INPUT)
+    what_i_do(argv[0],WID_STR);
+#endif
+
+  infile=search_datafile(argc,argv,0L,verbosity);
+  if (infile == NULL)
+    stdi=1;
+
+  if (outfile == NULL) {
+    if (!stdi) {
+      check_alloc(outfile=(char*)calloc(strlen(infile)+5,(size_t)1));
+      sprintf(outfile,"%s.cze",infile);
+    }
+    else {
+      check_alloc(outfile=(char*)calloc((size_t)10,(size_t)1));
+      sprintf(outfile,"stdin.cze");
+    }
+  }
+  if (!stdo)
+    test_outfile(outfile);
+
+  if (COLUMNS == NULL)
+    both=(double**)get_multi_series(infile,&LENGTH,exclude,&dummy,"",
+				    (char)1,verbosity);
+  else
+    both=(double**)get_multi_series(infile,&LENGTH,exclude,&dummy,COLUMNS,
+				    (char)0,verbosity);
+  series1=both[0];
+  series2=both[1];
+  rescale_data(series1,LENGTH,&min,&hinter);
+  interval=hinter;
+  rescale_data(series2,LENGTH,&min,&hinter);
+  interval=(interval+hinter)/2.0;
+
+  variance(series2,LENGTH,&av2,&rms2);
+  
+  check_alloc(list=(long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(found=(unsigned long*)malloc(sizeof(long)*LENGTH));
+  check_alloc(done=(char*)malloc(sizeof(char)*LENGTH));
+  check_alloc(box=(long**)malloc(sizeof(long*)*NMAX));
+  check_alloc(error=(double*)malloc(sizeof(double)*STEP));
+  for (i=0;i<STEP;i++)
+    error[i]=0.0;
+
+  for (i=0;i<NMAX;i++)
+    check_alloc(box[i]=(long*)malloc(sizeof(long)*NMAX));
+    
+  for (i=0;i<LENGTH;i++)
+    done[i]=0;
+
+  alldone=0;
+  if (epsset)
+    EPS0 /= interval;
+
+  epsilon=EPS0/EPSF;
+  clength=(CLENGTH <= LENGTH) ? CLENGTH-STEP : LENGTH-STEP;
+
+  while (!alldone) {
+    alldone=1;
+    epsilon*=EPSF;
+    make_box(series1,box,list,LENGTH-STEP,NMAX,DIM,DELAY,epsilon);
+    for (i=(DIM-1)*DELAY;i<clength;i++)
+      if (!done[i]) {
+	actfound=find_neighbors(series1,box,list,series2+i,LENGTH,NMAX,
+				DIM,DELAY,epsilon,found);
+	if (actfound >= MINN) {
+	  for (j=1;j<=STEP;j++)
+	    error[j-1] += make_fit(i,actfound,j);
+	  done[i]=1;
+	}
+	alldone &= done[i];
+      }
+  }
+  if (stdo) {
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Writing to stdout\n");
+    for (i=0;i<STEP;i++)
+      fprintf(stdout,"%lu %e\n",i+1,
+	      sqrt(error[i]/(clength-(DIM-1)*DELAY))/rms2);
+  }
+  else {
+    file=fopen(outfile,"w");
+    if (verbosity&VER_INPUT)
+      fprintf(stderr,"Opened %s for writing\n",outfile);
+    for (i=0;i<STEP;i++)
+      fprintf(file,"%lu %e\n",i+1,
+	      sqrt(error[i]/(clength-(DIM-1)*DELAY))/rms2);
+    fclose(file);
+  }
+  
+  return 0;
+}
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/Makefile.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/Makefile.in	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,71 @@
+SHELL = /bin/sh
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+BINDIR = ${exec_prefix}/@bindir@
+
+FC = @FC@
+FFLAGS = @FFLAGS@
+LDFLAGS = @LDFLAGS@
+AR = @AR@
+ARFLAGS = @ARFLAGS@
+RANLIB = @RANLIB@
+INSTALL = @INSTALL@
+LOADLIBES = libtsa.a libsla.a
+ERRUNIT = @ERRUNIT@
+
+# list of executables we want to produce
+   BINS = c1 c2naive xc2 \
+          c2d c2g c2t \
+          pc predict stp \
+          lazy project addnoise compare upo upoembed cluster \
+          choose rms notch autocor spectrum wiener1 wiener2 \
+	  surrogates endtoend timerev \
+          events intervals spikespec spikeauto \
+          henon ikeda lorenz ar-run xrecur 
+
+# list of objects to be put in libtsa.a 
+   INC  = readfile.o xreadfile.o \
+          arguments.o commandline.o any_s.o istdio.o help.o verbose.o \
+          d1.o neigh.o normal.o rank.o \
+          nmore.o store_spec.o tospec.o
+
+all: $(BINS) Randomize
+
+istdio.o: istdio_temp.f
+	sed "s#ERRUNIT#${ERRUNIT}#" istdio_temp.f > istdio.f
+	$(FC) $(FFLAGS) -c istdio.f -o istdio.o
+
+$(BINS): libtsa.a libsla.a *.f
+	-$(FC) $(FFLAGS) -o $@ $@.f $(LOADLIBES) $(LDFLAGS)
+
+libtsa.a: $(INC)
+	$(AR) $(ARFLAGS) libtsa.a $?
+	$(RANLIB) libtsa.a
+
+libsla.a: slatec/*.f
+	(cd slatec && $(MAKE))
+
+Randomize: libtsa.a libsla.a
+	-(cd randomize && $(MAKE))
+
+clean:
+	@rm -f istdio.f
+	@rm -f $(BINS)
+	-(cd randomize && $(MAKE) clean)
+
+install: $(BINS)
+	-for bin in $(BINS); do $(INSTALL) $$bin $(BINDIR); done
+	-(cd randomize && $(MAKE) $@)
+
+missing:
+	-@for bin in $(BINS); do \
+	   test -z "`$$bin -h 2>&1 | grep Usage`" \
+	      && echo   $$bin "(Wuppertal Fortran)" >>  ../missing.log; \
+	   $$bin -h 2>&1 | cat >> ../install.log; \
+	  done; :
+	-@(cd randomize && $(MAKE) $@)
+
+uninstall:
+	-@for bin in $(BINS); do rm -f $(BINDIR)/$$bin;	done
+	-@(cd randomize && $(MAKE) $@)
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/addnoise.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/addnoise.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,102 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   addnoise.f
+c
+c   add Gaussian / uniform white noise
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      parameter(nx=1000000)
+      character*72 file, fout
+      dimension x(nx)
+      external rand
+      data eps/0./, frac/0./, iuni/0/
+      data iverb/1/
+
+      call whatido("add Gaussian/uniform noise",iverb)
+      eps=fcan("r",eps)
+      frac=fcan("v",frac)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      if(lopt("u",1).eq.1) iuni=1
+      isout=igetout(fout,iverb)
+      if(eps.eq.0.and.frac.eq.0.) call usage()
+
+      if(lopt("0",1).eq.1.and.eps.gt.0) then
+         if(isout.eq.1) fout="0_noisy"
+         do 10 n=1,nmaxx
+            if(iuni.eq.1) then
+               x(n)=rand(0.0)*eps
+            else
+               x(n)=rgauss(0.0,eps)
+            endif
+ 10         continue
+         call writefile(nmaxx,x,fout,iverb)
+         stop
+      endif
+ 
+      do 20 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         call rms(nmax,x,sc,sd)
+         if(frac.gt.0) eps=sd*frac
+         if(iuni.eq.1) then
+            if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .      "adding uniform noise in [0,", eps,"]"
+         else
+            if(iv_io(iverb).eq.1) write(istderr(),*)  
+     .      "adding Gaussian noise of amplitude", eps
+         endif
+         if(sd.gt.0.and.iv_io(iverb).eq.1) write(istderr(),*)  
+     .      "that is",eps/sd,"* rms of data"
+         do 30 n=1,nmax
+            if(iuni.eq.1) then
+               x(n)=x(n)+rand(0.0)*eps
+            else
+               x(n)=x(n)+rgauss(0.0,eps)
+            endif
+ 30         continue
+         if(isout.eq.1) call addsuff(fout,file,"_noisy")
+ 20      call writefile(nmax,x,fout,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-r# | -v#] [-u -0 -o outfile -l# -x# -c# -V# -h] file(s)")
+      call ptext("either -r or -v must be present")
+      call popt("r","absolute noise level")
+      call popt("v","same as fraction of standard deviation")
+      call popt("u","add uniform noise (default Gaussian)")
+      call popt("0","do not read input, just issue random numbers")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_noisy")
+      call pall()
+      stop
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/any_s.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/any_s.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,43 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   any_s.f
+c   extract numbers from strings
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      function i_s(s,ierr)
+      character*(*) s
+
+      ierr=0
+      read(s,'(i20)',err=777) i_s
+      if(s.ne.'-'.and.s.ne.'+') return   ! reject a solitary - or +
+ 777  ierr=1
+      end
+
+      function f_s(s,ierr)
+      character*(*) s
+
+      ierr=0
+      read(s,'(f20.0)',err=777) f_s
+      if(s.ne.'-'.and.s.ne.'+') return   ! reject a solitary - or +
+ 777  ierr=1
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/ar-run.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/ar-run.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,99 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   ar-run.f
+c   iterate AR model, e.g. as fitted by ar-model (Dresden)
+c   author T. Schreiber (1999)
+c===========================================================================
+
+      parameter(npmax=100)
+      character*72 file, fout, fline
+      dimension x(-npmax:npmax), a(npmax)
+      external rand
+      data np/npmax/, ntrans/10000/, iuni/0/
+      data iverb/1/
+
+      call whatido("iterate AR model, e.g. as fitted by ar-model",iverb)
+      np=ican("p",np)
+      if(np.gt.npmax) stop "ar-run: make npmax larger."
+      nmax=imust('l')
+      ntrans=ican("x",ntrans)
+      if(lopt("u",1).eq.1) iuni=1
+      r=rand(sqrt(abs(fcan("I",0.0))))
+      isout=igetout(fout,iverb)
+
+      do 10 n=1,npmax
+         x(-n)=0.
+ 10      x(n)=0.
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      read(iunit,'(a)') fline
+      if(fline(1:1).eq."#") then
+         read(fline(18:72),'(f20.0)',err=999) var
+         do 20 j=1,np
+            read(iunit,'(a1,f20.0)',err=999) fline(1:1), a(j)
+ 20         if(fline(1:1).ne."#") goto 1
+      else
+         read(fline(1:72),'(f20.0)',err=999) var
+         do 30 j=1,np
+ 30         read(iunit,'(f20.0)',err=999,end=1) a(j)
+      endif
+ 1    np=j-1
+      if(iv_echo(iverb).eq.1) then
+         write(istderr(),*) 'coefficients:      ', (a(i),i=1,np)
+         write(istderr(),*) 'driving amplitude: ', var
+      endif
+      if(isout.eq.1) fout="ar.dat"
+      call outfile(fout,iunit,iverb)
+      n=-ntrans
+ 2    n=n+1
+      nn=mod(n+ntrans,np)+1
+      xx=rgauss(0.0,var)
+      do 40 j=1,np
+ 40      xx=xx+a(j)*x(nn-j)
+      x(nn)=xx
+      x(nn-np)=xx
+      if(n.lt.1) goto 2
+      write(iunit,*) xx
+      if(nmax.eq.0.or.n.lt.nmax) goto 2
+      stop
+
+ 999  write(istderr(),'(a)') "wrong input format! try:"
+      write(istderr(),'(a)') "(rms of increments)"
+      write(istderr(),'(a)') "a(1)"
+      write(istderr(),'(a)') "a(2)"
+      write(istderr(),'(a)') "..."
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-l# [-p# -I# -o outfile -x# -V# -h] file")
+      call popt("l","number of iterations (l=0: infinite)")
+      call popt("p","order of AR-model (default determined from input)")
+      call popt("I","seed for random numbers")
+      call popt("x","number of transients discarded (10000)")
+      call pout("ar.dat")
+      call pall()
+      stop
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/arguments.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/arguments.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,159 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   arguments.f
+c   get command line arguments 
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      subroutine argdel(i)
+      parameter(margs=1000)
+      dimension largs(margs)
+      common /args/ nargs, largs
+
+      if(i.eq.0) then
+         nargs=min(margs,iargc())
+         do 10 n=1,nargs
+ 10         largs(n)=1
+      else
+         if(i.gt.iargc()) return
+         if(largs(i).eq.0) return
+         largs(i)=0
+         nargs=nargs-1
+      endif
+      end
+
+      function nstrings()
+      parameter(margs=1000)
+      dimension largs(margs)
+      common /args/ nargs, largs
+
+      nstrings=max(nargs,1)
+      end
+
+      subroutine nthstring(n,string)
+      parameter(margs=1000)
+      dimension largs(margs)
+      common /args/ nargs, largs
+      character*(*) string
+
+      iv=0
+      do 10 i=1,iargc()
+         if(largs(i).eq.1) iv=iv+1
+ 10      if(iv.eq.n) goto 1
+      string="-"
+      return
+ 1    call getarg(i,string)
+      end
+
+      function imust(c)
+c get mandatory integer argument, call usage statement if missing
+      character c
+
+      imust=iopt(c,1,ierr)
+      if(ierr.ne.0) call usage()
+      end
+
+      function fmust(c)
+c get mandatory real argument, call usage statement if missing
+      character c
+
+      fmust=fopt(c,1,ierr)
+      if(ierr.ne.0) call usage()
+      end
+
+      subroutine smust(c,string)
+c get mandatory string argument, call usage statement if missing
+      character c
+      character*(*) string
+
+      call sopt(c,1,string,ierr)
+      if(ierr.ne.0) call usage()
+      end
+
+      function ican(c,idef)
+c get optional integer argument, provide default if missing
+      character c
+
+      ican=iopt(c,1,ierr)
+      if(ierr.ne.0) ican=idef
+      end
+      
+      function fcan(c,fdef)
+c get optional real argument, provide default if missing
+      character c
+
+      fcan=fopt(c,1,ierr)
+      if(ierr.ne.0) fcan=fdef
+      end
+
+      subroutine stcan(c,string,dstring)
+c get optional string argument, provide default if missing
+      character c
+      character*(*) string, dstring
+
+      call sopt(c,1,string,ierr)
+      if(ierr.ne.0) string=dstring
+      end
+
+      function igetout(fout,iverb)
+c gets alternate output file name, default " "
+c return 1 if fout must be determined from input file name
+      character*(*) fout
+
+      igetout=0
+      call stcan("o",fout," ")
+      if(fout.ne." ".and.nstrings().gt.1.and.iv_io(iverb).ne.0) 
+     .   write(istderr(),*) '*** single output file for multiple'//
+     .   ' input files - results may be overwritten'
+      if(fout.ne." ") return
+      igetout=lopt("o",1)
+      end
+
+      subroutine imcan(c,mmax,mc,ilist)
+c get optional integer argument with multiple comma separated values
+      character c
+      character*72 string
+      dimension ilist(*)
+
+      call stcan(c,string," ")
+      string(index(string," "):index(string," "))=","
+      do 10 m=1,mmax
+         if(index(string,",").le.1) goto 1
+         read(string(1:index(string,",")-1),*,err=1,end=1) ilist(m)
+ 10      string=string(index(string,",")+1:72)
+ 1    mc=m-1
+      end
+
+      subroutine fmcan(c,mmax,mc,flist)
+c get optional real argument with multiple comma separated values
+      character c
+      character*72 string
+      dimension flist(*)
+
+      call stcan(c,string," ")
+      string(index(string," "):index(string," "))=","
+      do 10 m=1,mmax
+         if(index(string,",").le.1) goto 1
+         read(string(1:index(string,",")-1),*,err=1,end=1) flist(m)
+ 10      string=string(index(string,",")+1:72)
+ 1    mc=m-1
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/autocor.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/autocor.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,96 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   autocor.f
+c   autocorrelation function through FFT
+c   author T. Schreiber (1998), H. Kantz (2007)
+c===========================================================================
+
+      parameter(nx=1000000)
+      dimension x(2*nx)
+      character*72 file, fout
+      data iverb/1/
+
+      call whatido("autocorrelation function estimated by FFT",iverb)
+      ivar=lopt('v',1)
+      iper=lopt('p',1)
+      iexact=lopt('P',1)
+      if(iexact.ne.0) iper=1
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         if(ivar.eq.0) call normal(nmax,x,sc,sd)
+         if(iper.eq.0) then
+            nmaxp=nmore(2*nmax)
+            do 20 n=nmax+1,nmaxp
+ 20            x(n)=0.
+            call store_spec(nmaxp,x,1)
+            do 30 n=1,nmax
+ 30            x(n)=x(n)/real(nmax-n+1)
+         else
+            nmaxp=nmax
+            if(iexact.eq.0) then
+               nmaxp=nless(nmax)
+               if(nmaxp.ne.nmax.and.iv_io(iverb).eq.1)  
+     .            write(istderr(),*) "autocor: using", nmaxp
+            endif
+            call store_spec(nmaxp,x,1)
+            do 50 n=1,nmaxp
+ 50            x(n)=x(n)/real(nmaxp)
+         endif
+         if(isout.eq.1) call addsuff(fout,file,"_co")
+         call outfile(fout,iunit,iverb)
+         if(ivar.eq.0) then
+            if(sd.eq.0) stop "autocor: cannot normalise - zero variance"
+            fsc=1./x(1)
+         else
+            fsc=1.
+         endif
+         do 60 n=1,min(nmax,nmaxp)
+ 60         write(iunit,*) n-1, fsc*x(n)
+ 10      if(iunit.ne.istdout()) close(iunit)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-v -p -P -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("v","give unnormalised autocovariance")
+      call popt("p","assume periodic continuation")
+      call popt("P","assume periodic continuation exactly")
+      call popt("l","number of values to be read [all]")
+      call popt("x","number of values to be skipped [0]")
+      call popt("c","column to be read [1 or file,#]")
+      call pout("file_co")
+      call pall()
+      stop
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/c1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/c1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,92 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   information dimension, fixed mass
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997)
+c   author T. Schreiber (1999)
+c===========================================================================
+
+      parameter(nx=100000,mx=10)
+      dimension x(nx,mx), icol(mx)
+      character*72 file, fout
+      data kmax/100/, res/2./
+      data iverb/1/
+      external rand
+
+      call whatido("fixed mass approach to d1 estimation",iverb)
+      id=imust("d")
+      mfrom=imust("m")
+      mto=imust("M")
+      ntmin=imust("t")
+      ncmin=imust("n")
+      res=fcan("#",res)
+      r=rand(sqrt(abs(fcan("I",0.0))))
+      kmax=ican("K",kmax)
+      resl=log(2.)/res
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      call columns(mc,mx,icol)
+      mcmax=max(1,mc)
+      isout=igetout(fout,iverb)
+      if(fout.eq." ") isout=1
+
+      call nthstring(1,file)
+      call xreadfile(nmax,mcmax,nx,x,nexcl,icol,file,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_c1")
+      call outfile(fout,iunit,iverb)
+      do 10 m=mfrom,mto
+         write(iunit,'(4h#m= ,i5)') m
+         pr=0.
+         do 20 pl=log(1./(nmax-(m-1)*id)),0.,resl
+            pln=pl
+            call d1(nmax,mcmax,nx,x,id,m,ncmin,pr,pln,rln,ntmin,kmax)
+            if(pln.eq.pr) goto 20
+            it=it+1
+            pr=pln
+            write(iunit,*)   exp(rln), exp(pln)
+ 20         continue
+         write(iunit,'()')
+ 10      write(iunit,'()')
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-d# -m# -M# -t# -n# "//
+     .   "[-## -K# -o outfile -I# -l# -x# -c#,# -V# -h] file")
+      call popt("d","delay")
+      call popt("m","minimal total embedding dimension")
+      call popt("M","maximal total embedding dimension")
+      call popt("t","minimal time separation")
+      call popt("n","minimal number of center points")
+      call popt("#","resolution, values per octave (2)")
+      call popt("K","maximal number of neighbours (100)")
+      call popt("I","seed for random numbers")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column(s) to be read (1 or file,#)")
+      call pout("file_c1")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/c2d.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/c2d.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,90 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   c2d.f
+c   local slopes from c2
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      parameter(meps=1000)
+      dimension e(meps), c(meps)
+      character*72 file, fout, aline
+      data iav/1/
+      data iverb/1/
+
+      call whatido("local slopes from c1/c2 correlation sum data",iverb)
+      iav=ican('a',iav)
+      isout=igetout(fout,iverb)
+      if(nstrings().eq.0) call usage()
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      if(isout.eq.1) call addsuff(fout,file,"_d")
+      call outfile(fout,iunit2,iverb)
+ 1    read(iunit,'(a)',end=999) aline
+ 4    if(aline(1:1).ne."#") goto 1
+      if(aline(1:1).eq."#") 
+     .   read(aline(index(aline,"m=")+2:72),'(i20)',err=1) m
+      me=0
+ 2    read(iunit,'(a)') aline
+      if(aline(1:72).eq." ") goto 3
+      read(aline,*,err=999,end=999) ee, cc
+      if(cc.le.0.) goto 3
+      me=me+1
+      e(me)=log(ee)
+      c(me)=log(cc)
+      goto 2
+ 3    write(iunit2,'(4h#m= ,i5)') m
+      do 30 j=iav+1,me-iav
+         call slope(e(j-iav),c(j-iav),2*iav+1,s)
+ 30      if(s.gt.0.) write(iunit2,*) exp(0.5*(e(j+iav)+e(j-iav))),  s
+      write(iunit2,'()') 
+      write(iunit2,'()') 
+      goto 4
+ 999  stop
+      end
+
+      subroutine slope(x,y,n,a)
+      dimension x(n),y(n)
+
+      sx=0.
+      sa=0
+      a=0.
+      do 10 i=1,n
+ 10      sx=sx+x(i)
+      do 20 i=1,n
+         sa=sa+(x(i)-sx/n)**2
+ 20      a=a+y(i)*(x(i)-sx/n)
+      a=a/sa
+      end
+
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-a# -o outfile -V# -h] file")
+      call popt("a","average using -#,...,+# [1]")
+      call pout("file_d")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/c2g.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/c2g.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,109 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   c2g.f
+c   Gaussian kernel correlation integral from c2
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(meps=1000)
+      dimension e(meps), c(meps), lw(meps)
+      character*72 file, fout, aline
+      double precision g,gd,h,d,f,func,gg,ggd,err,dum1,dum2,a,b,dc,de
+      external func, funcd
+      common h,d,f
+      data iverb/1/
+
+      call whatido("Gaussian kernel correlation sum from c2",iverb)
+      isout=igetout(fout,iverb)
+      if(nstrings().eq.0) call usage()
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      if(isout.eq.1) call addsuff(fout,file,"_g")
+      call outfile(fout,iunit2,iverb)
+ 1    read(iunit,'(a)',end=999) aline
+ 4    if(aline(1:1).ne."#") goto 1
+      if(aline(1:1).eq."#") 
+     .   read(aline(index(aline,"m=")+2:72),'(i20)',err=1) m
+      me=0
+ 2    read(iunit,'(a)') aline
+      if(aline(1:72).eq." ") goto 3
+      me=me+1
+      read(aline,*,err=999,end=999) ee, cc
+      if(cc.le.0.) goto 3
+      e(me)=log(ee)
+      c(me)=log(cc)
+      goto 2
+ 3    write(iunit2,'(4h#m= ,i5)') m
+      call indexx(me,e,lw)
+      call index2sort(me,e,lw)
+      call index2sort(me,c,lw)
+      do 10 j=1,me
+         h=exp(e(j))
+         g=0
+         gd=0
+         do 20 k=1,me-1
+            f=exp((e(k+1)*c(k)-e(k)*c(k+1))/(e(k+1)-e(k)))
+            d=(c(k+1)-c(k))/(e(k+1)-e(k))
+            a=e(k)
+            b=e(k+1)
+            gg=0.
+            ggd=0.
+            if(b.ne.a) call dqk15(func,a,b,gg,err,dum1,dum2)
+            if(b.ne.a) call dqk15(funcd,a,b,ggd,err,dum1,dum2)
+            g=g+gg
+ 20         gd=gd+ggd
+         dc=c(me)
+         de=e(me)
+         cgauss=g/(h**2)+exp(-exp(2*de)/(2*h**2))
+         cgd=gd/(h**4)+(2+exp(2*de)/h**2)*exp(-exp(2*de)/(2*h**2))
+ 10      write(iunit2,*) h, cgauss, -2+cgd/cgauss
+      write(iunit2,'()') 
+      write(iunit2,'()') 
+      goto 4
+ 999  stop
+      end
+
+      double precision function func(u)
+      double precision h,d,f,u
+      common h,d,f
+
+      func=f*exp((2+d)*u-exp(2*u)/(2*h**2))      
+      end
+
+      double precision function funcd(u)
+      double precision h,d,f,u
+      common h,d,f
+
+      funcd=f*exp((4+d)*u-exp(2*u)/(2*h**2))      
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-o outfile -V# -h] file")
+      call pout("file_g")
+      call pall()
+      stop
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/c2naive.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/c2naive.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,120 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   c2naive.f
+c   correlation integral c2, no fast neighbour search
+c   complete direct neighbour search
+c   author T. Schreiber (1998)
+c   modified H. Kantz, Feb. 2007
+c===========================================================================
+
+      parameter(nx=1000000,me=30,meps=800)
+      dimension x(nx), c(0:meps,me)
+c j=a*(log(d)-log(xmax-xmin))    d=xmax-xmin -> j=0
+c a=-rs/log(2.)                  d=s*2**(-j/res)
+      character*72 file, fout
+      data res/2./
+      data iverb/1/
+
+      call whatido("correlation sum, complete naive neighbour search,
+     .univariate data only"
+     .             ,iverb)
+      call whatido("univariate data only",iverb)
+      id=imust("d")
+      mmax=imust("M")
+      mmin=ican("m",1)
+      ntmin=imust("t")
+      ntmax=ican("T",nx)
+      res=fcan("#",res)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+      if(fout.eq." ") isout=1
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_c2")
+         call minmax(nmax,x,xmin,xmax)
+         sc=xmax-xmin
+         a=-res/log(2.)
+         do 20 m=mmin,mmax
+            do 20 j=0,meps
+ 20            c(j,m)=0.
+         call d2naive(nmax,x,id,mmin,mmax,c,meps,log(sc),a,ntmin,ntmax)
+         call outfile(fout,iunit,iverb)
+         do 30 m=mmin,mmax
+            write(iunit,'(4h#m= ,i5)') m
+            do 40 j=meps-1,0,-1
+ 40            c(j,m)=c(j,m)+c(j+1,m)
+            do 50 j=0,meps
+               if(c(j,m).eq.0.) goto 1
+ 50            write(iunit,*) sc*2**(-j/res), c(j,m)/c(0,m)
+ 1          write(iunit,'()')
+ 30         write(iunit,'()')
+         close(iunit)
+ 10      continue
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-d# -M# -t# [-m# -##"//
+     .   " -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("d","delay")
+      call popt("M","maximal embedding dimension")
+      call popt("t","minimal time separation")
+      call popt("m","minimal embedding dimension [1]")
+      call popt("#","resolution, values per octave [2]")
+c      call popt("T","for Guido")
+      call popt("l","number of values to be read [all]")
+      call popt("x","number of values to be skipped [0]")
+      call popt("c","column to be read [1 or file,#]")
+      call pout("file_c2")
+      call pall()
+      stop
+      end
+
+      subroutine d2naive(nmax,x,id,mmin,mmax,c,meps,scl,a,ntmin,ntmax)
+      parameter(nx=1000000,tiny=1e-30)
+      dimension x(nmax),c(0:meps,mmax),d(nx)
+
+      if(nmax.gt.nx) stop "d2naive: make nx larger."
+      nlast=min(nmax-(mmax-1)*id-1,ntmax)
+      do 10 ndt=ntmin,nlast
+         do 20 n=ndt+1,nmax
+ 20         d(n)=max(abs(x(n)-x(n-ndt)),tiny)
+         do 10 n=ndt+1+(mmax-1)*id,nmax
+            dmax=d(n)
+            do 30 m=2,mmin-1
+ 30            dmax=max(dmax,d(n-(m-1)*id))
+            j=int(a*(log(dmax)-scl))
+            do 10 m=mmin,mmax
+               if(d(n-(m-1)*id).gt.dmax) then
+                  dmax=d(n-(m-1)*id)
+                  j=int(a*(log(dmax)-scl))
+               endif
+ 10            c(j,m)=c(j,m)+1
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/c2t.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/c2t.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,81 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   c2t.f
+c   Takens' estimator from c2
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      parameter(meps=1000)
+      dimension e(meps), c(meps), lw(meps)
+      double precision a, b
+      character*72 file, fout, aline
+      data iverb/1/
+
+      call whatido("Takens' estimator from correlation sum data",iverb)
+      isout=igetout(fout,iverb)
+      if(nstrings().eq.0) call usage()
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      if(isout.eq.1) call addsuff(fout,file,"_t")
+      call outfile(fout,iunit2,iverb)
+ 1    read(iunit,'(a)',end=999) aline
+ 4    if(aline(1:1).ne."#") goto 1
+      if(aline(1:1).eq."#") 
+     .   read(aline(index(aline,"m=")+2:72),'(i20)',err=1) m
+      me=0
+ 2    read(iunit,'(a)') aline
+      if(aline(1:72).eq." ") goto 3
+      read(aline,*,err=999,end=999) ee, cc
+      if(cc.le.0.) goto 3
+      me=me+1
+      e(me)=log(ee)
+      c(me)=log(cc)
+      goto 2
+ 3    write(iunit2,'(4h#m= ,i5)') m
+      call indexx(me,e,lw)
+      call index2sort(me,e,lw)
+      call index2sort(me,c,lw)
+      cint=0
+      do 10 i=2,me
+         b=(e(i)*c(i-1)-e(i-1)*c(i))/(e(i)-e(i-1))
+         a=(c(i)-c(i-1))/(e(i)-e(i-1))
+         if(a.ne.0) then
+            cint=cint+(exp(b)/a)*(exp(a*e(i))-exp(a*e(i-1)))
+         else
+            cint=cint+exp(b)*(e(i)-e(i-1))
+         endif
+ 10      write(iunit2,*) exp(e(i)), exp(c(i))/cint
+      write(iunit2,'()') 
+      write(iunit2,'()') 
+      goto 4
+ 999  stop
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-o outfile -V# -h] file")
+      call pout("file_t")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/choose.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/choose.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,60 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   choose.f
+c   Choose columns and sub-sequences from a file
+c   author T. Schreiber (1999)
+c===========================================================================
+
+      parameter(nx=1000000,mx=5)
+      dimension x(nx,mx), icol(mx)
+      character*72 file, fout
+      data iverb/15/
+
+      call whatido("Choose columns and sub-sequences from a file",iverb)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      mcmax=ican("m",0)
+      call columns(mc,mx,icol)
+      if(mcmax.eq.0) mcmax=max(1,mc)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call xreadfile(nmax,mcmax,nx,x,nexcl,icol,file,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_select")
+      call outfile(fout,iunit,iverb)
+      call xwritefile(nmax,mcmax,nx,x,fout,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-o outfile -l# -x# -m# -c#[,#] -V# -h] file")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("m","number of columns to be read (1)")
+      call popt("c","columns to be read (1)")
+      call pout("file_select")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/cluster.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/cluster.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,195 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   clustering a dissimilarity matrix
+c   see Schreiber and Schmitz, Phys. Rev. Lett. 79 (1997) 1475
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      parameter(npmax=1000)
+      dimension d(npmax,npmax), iu(npmax), ifix(npmax)
+      character*72 file, fout, filex
+      data iverb/3/
+
+      call whatido("clustering a dissimilarity matrix",iverb)
+      ncl=imust("#")
+      iflag=lopt("=",1)
+      call stcan('X',filex,' ')
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_clust")
+      do 10 i=1,npmax
+         do 10 j=1,npmax
+ 10         d(i,j)=-1e20
+      np=0
+ 1    read(iunit,*,end=999) i,j,dij
+      d(i,j)=dij
+      np=max(i,j,np)
+      goto 1
+ 999  if(iv_io(iverb).eq.1) write(0,'(a,i)') "matrix size ", np
+      dmean=0
+      nd=0
+      do 20 i=1,np
+         do 20 j=1,np
+            if(d(i,j).ne.-1e20) then
+               nd=nd+1
+               dmean=dmean+d(i,j)
+            endif
+ 20         continue
+      do 30 i=1,np
+         do 30 j=1,np
+ 30         if(d(i,j).eq.-1e20) d(i,j)=dmean/nd
+      do 40 i=1,np
+ 40      ifix(i)=0
+      if(filex.ne." ") then
+         open(10,file=filex,status='old',err=998)
+         nfix=0
+ 2       read(10,*,end=998,err=2) i, iff
+         if(i.lt.1.or.i.gt.np.or.iff.gt.ncl.or.iff.lt.1) goto 1
+         ifix(i)=iff
+         nfix=nfix+1
+      endif
+ 998  if(nfix.eq.np) stop "all fixed."
+      call clustering(np,d,npmax,ncl,nfix,ifix,iu,iverb,iflag)
+      call outfile(fout,iunit,iverb)
+      do 50 n=1,np
+ 50      write(iunit,*) iu(n), (costi(np,iu,d,n,ic,iflag),ic=1,ncl)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed("-## [-= -X xfile] file")
+      call popt("#","number of clusters")
+      call popt("=","if set, bias towards similar size clusters")
+      call popt("X","list of indices with fixed cluster assignments")
+      call pout("file_clust")
+      call pall()
+      call ptext("Verbosity levels (add what you want):")
+      call ptext("          1 = input/output" )
+      call ptext("          2 = state of clustering")
+      call ptext("          8 = temperature / cost at cooling")
+      stop
+      end
+
+      subroutine clustering(np,d,npmax,ncl,nfix,ifix,iu,iverb,iflag)
+      parameter(nt0=20,tfac=10.,tstep=0.99,ntotmaxf=20,nsuccmaxf=2)
+      external rand
+      character*1 c
+      dimension d(npmax,npmax), iu(*), ifix(*)
+      equivalence (c,ic)
+      data c/'A'/
+
+      ntotmax=(np-nfix)*ntotmaxf
+      nsuccmax=(np-nfix)*nsuccmaxf
+      se=0.
+      se2=0.
+      do 10 nt=1,nt0
+         call ranconf(np,iu,ncl,ifix)
+         e=cost(np,iu,d,ncl,iflag)
+         se=se+e
+ 10      se2=se2+e**2
+      t=tfac*sqrt(se2/nt0-(se/nt0)**2)
+
+      ntot=0
+      nsucc=0
+ 1    call cconf(np,iu,ncl,nch,iuold,ifix)
+      ec=cost(np,iu,d,ncl,iflag)
+      ntot=ntot+1
+      if(ec.lt.e.or.(rand(0.0).lt.exp(-(ec-e)/t))) then
+         e=ec
+         nsucc=nsucc+1
+      else
+         iu(nch)=iuold
+      endif
+      if(ntot.eq.ntotmax .or. nsucc.eq.nsuccmax) then
+         if(nsucc.eq.0) return
+         ntot=0
+         nsucc=0
+         if(iv_clust(iverb).eq.1) write(istderr(),'(80a1)') 
+     .      (ic+iu(n)-1,n=1,np)
+         if(iv_cool(iverb).eq.1) write(istderr(),*) t, e
+         t=t*tstep
+      endif
+      goto 1
+      end
+
+      function cost(np,iu,d,ncl,iflag)
+      parameter(npmax=1000)
+      dimension d(npmax,npmax), iu(*), ictab(npmax)
+      
+      cost=0
+      do 10 ic=1,ncl
+         nic=0
+         do 20 n=1,np
+            if(iu(n).ne.ic) goto 20
+            nic=nic+1
+            ictab(nic)=n
+ 20         continue
+         cc=0
+         do 30 ii=1,nic
+            i=ictab(ii)
+            do 30 jj=1,nic
+               j=ictab(jj)
+ 30            cc=cc+d(i,j)
+ 10      if(nic.gt.0) cost=cost+cc/(1+(1-iflag)*(nic-1))
+      end
+
+      function costi(np,iu,d,nn,ic,iflag)
+      parameter(npmax=1000)
+      dimension d(npmax,npmax), iu(*), ictab(npmax)
+      
+      costi=0
+      nic=0
+      do 20 n=1,np
+         if(iu(n).ne.ic) goto 20
+         nic=nic+1
+         ictab(nic)=n
+ 20      continue
+      cc=0
+      do 30 jj=1,nic
+         j=ictab(jj)
+ 30      cc=cc+d(nn,j)+d(j,nn)
+      if(nic.gt.0) costi=0.5*cc/(1+(1-iflag)*(nic-1))
+      end
+
+      subroutine ranconf(np,iu,ncl,ifix)
+      external rand
+      dimension iu(*), ifix(*)
+
+      do 10 n=1,np
+         iu(n)=ifix(n)
+ 10      if(ifix(n).eq.0) iu(n)=min(int(rand(0.0)*ncl)+1,ncl)
+      end
+
+      subroutine cconf(np,iu,ncl,nch,iuold,ifix)
+      external rand
+      dimension iu(*), ifix(*)
+
+ 1    nch=min(int(rand(0.0)*np)+1,np)
+      if(ifix(nch).ne.0) goto 1
+      iuold=iu(nch)
+      iu(nch)=iuold+int(rand(0.0)*(ncl-1))+1
+      if(iu(nch).gt.ncl) iu(nch)=iu(nch)-ncl
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/commandline.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/commandline.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,162 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   commandline.f
+c   get command line options
+c   author T. Schreiber (1998)
+c===========================================================================
+
+      function iopt(c,ith,ierr)
+c get ith occurence of switch -c as integer
+      character*72 argv
+      character c
+
+      iopt=0
+      ifound=0
+      do 10 i=1,iargc()
+         call getarg(i,argv)
+         if(argv(1:2).eq.'-'//c) then
+            ifound=ifound+1
+            if(ifound.eq.ith) then
+               call argdel(i)
+               if(argv(3:72).ne.' ') then
+                  iopt=i_s(argv(3:72),ierr)
+               else if(i+1.le.iargc()) then
+                  call getarg(i+1,argv)
+                  iopt=i_s(argv,ierr)
+                  if(ierr.eq.0) call argdel(i+1)
+               else
+                  ierr=1
+               endif
+               return
+            endif
+         endif
+ 10      continue
+      ierr=1
+      end
+
+      function fopt(c,ith,ierr)
+c get ith occurence of switch -c as real
+      character*72 argv
+      character c
+
+      fopt=0
+      ifound=0
+      do 10 i=1,iargc()
+         call getarg(i,argv)
+         if(argv(1:2).eq.'-'//c) then
+            ifound=ifound+1
+            if(ifound.eq.ith) then
+               call argdel(i)
+               if(argv(3:72).ne.' ') then
+                  fopt=f_s(argv(3:72),ierr)
+               else if(i+1.le.iargc()) then
+                  call getarg(i+1,argv)
+                  fopt=f_s(argv,ierr)
+                  if(ierr.eq.0) call argdel(i+1)
+               else
+                  ierr=1
+               endif
+               return
+            endif
+         endif
+ 10      continue
+      ierr=1
+      end
+
+      subroutine sopt(c,ith,string,ierr)
+c get ith occurence of switch -c as string
+      character*(*) string
+      character c
+
+      ifound=0
+      do 10 i=1,iargc()
+         call getarg(i,string)
+         if(string(1:2).eq.'-'//c) then
+            ifound=ifound+1
+            if(ifound.eq.ith) then
+               call argdel(i)
+               if(string(3:).ne.' ') then
+                  string=string(3:)
+                  ierr=0
+               else if(i+1.le.iargc()) then
+                  call getarg(i+1,string)
+                  if(string(1:1).eq."-") then
+                     ierr=1
+                     return
+                  endif
+                  call argdel(i+1)
+                  ierr=0
+               else
+                  ierr=1
+               endif
+               return
+            endif
+         endif
+ 10      continue
+      ierr=1
+      end
+
+      function lopt(c,ith)
+c test if ith occurence of switch -c is present
+      character*72 argv
+      character c
+
+      lopt=0
+      ifound=0
+      do 10 i=1,iargc()
+         call getarg(i,argv)
+         if(argv(1:2).eq.'-'//c) then
+            ifound=ifound+1
+            if(ifound.eq.ith) then
+               lopt=1
+               call argdel(i)
+               return
+            endif
+         endif
+ 10      continue
+      end
+
+      function iget(inum)
+c get inum'th argument as integer
+      character*72 argv
+      
+      iget=0
+      call getarg(inum,argv)
+      if(argv.eq.' ') 
+     .write(istderr(),'(a,i10)') "iget: missing integer argument",inum
+      iget=i_s(argv,ierr)
+      if(ierr.ne.0) 
+     .write(istderr(),'(a,i10)') "iget: integer argument expected:",inum
+      end
+
+      function fget(inum)
+c get inum'th argument as real
+      character*72 argv
+      
+      fget=0
+      call getarg(inum,argv)
+      if(argv.eq.' ') 
+     .   write(istderr(),'(a)') "fget: missing real argument",inum
+      fget=f_s(argv,ierr)
+      if(ierr.ne.0) 
+     .   write(istderr(),'(a)') "fget: real argument expected:;",inum
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/compare.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/compare.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,72 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   compare.f
+c   compare two data sets
+c   author T. Schreiber
+c===========================================================================
+
+      parameter(nx=1000000,mx=2)
+      character*72 file
+      dimension x(nx,mx), icol(mx)
+      data iverb/1/
+
+      call whatido("compare time series in RMS sense",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      call columns(mc,mx,icol)
+      mcmax=mx
+      if(nstrings().ne.1) call usage()
+      call nthstring(1,file)
+
+      nmax=nmaxx
+      call xreadfile(nmax,mcmax,nx,x,nexcl,icol,file,iverb)
+      if(file.eq."-") file="stdin"
+
+      call rms(nmax,x(1,1),sc1,sd1)
+      call rms(nmax,x(1,2),sc2,sd2)
+      do 10 n=1,nmax
+ 10      x(n,1)=x(n,2)-x(n,1)
+      call rms(nmax,x(1,1),scd,sdd)
+
+      write(istderr(),*)
+      write(istderr(),*) "col ", icol(1), ": Mean ", sc1, 
+     .   ", standard deviation ", sd1
+      write(istderr(),*) "col ", icol(2), ": Mean ", sc2, 
+     .   ", standard deviation ", sd2
+      write(istderr(),*)
+      write(istderr(),*) "mean difference              ", scd 
+      write(istderr(),*)  
+     .   "root mean squared difference ", sqrt(sdd**2+scd**2) 
+      write(istderr(),*) "standard deviation           ", sdd
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-l# -x# -c#[,#] -V# -h] file")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","columns to be read (1,2)")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/d1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/d1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,116 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   
+c   d1 with finite sample correction following Grassberger
+c   subroutine for c1
+c
+c===========================================================================
+      subroutine d1(nmax,mmax,nxx,y,id,m,ncmin,pr,pln,eln,nmin,kmax)
+      parameter(im=100,ii=100000000,nx=100000,tiny=1e-20) 
+      dimension y(nxx,mmax),jh(0:im*im),ju(nx),d(nx),jpntr(nx),
+     .   nlist(nx),nwork(nx)
+      external rand
+
+      if(nmax.gt.nx) stop "d1: make nx larger."
+      mt=(m-1)/mmax+1
+      ncomp=nmax-(mt-1)*id
+      kpr=int(exp(pr)*(ncomp-2*nmin-1))+1
+      k=int(exp(pln)*(ncomp-2*nmin-1))+1
+      if(k.gt.kmax) then
+         ncomp=real(ncomp-2*nmin-1)*real(kmax)/k+2*nmin+1
+         k=kmax
+      endif         
+      pln=psi(k)-log(real(ncomp-2*nmin-1))
+      if(k.eq.kpr) return
+      write(istderr(),*) 'Mass ', exp(pln),': k=', k, ', N=', ncomp 
+      call rms(nmax,y,sc,sd)
+      eps=exp(pln/m)*sd
+      do 10 i=1,nmax-(mt-1)*id
+ 10      ju(i)=i+(mt-1)*id
+      do 20 i=1,nmax-(mt-1)*id
+         iperm=min(int(rand(0.0)*nmax-(mt-1)*id)+1,nmax-(mt-1)*id)
+         ih=ju(i)
+         ju(i)=ju(iperm)
+ 20      ju(iperm)=ih
+      iu=ncmin
+      eln=0
+ 1    call mbase(ncomp+(mt-1)*id,mmax,nxx,y,id,m,jh,jpntr,eps)
+      iunp=0
+      do 30 nn=1,iu                                           ! find neighbours
+         n=ju(nn)
+         call mneigh(nmax,mmax,nxx,y,n,nmax,id,m,jh,jpntr,eps,
+     .      nlist,nfound)
+         nf=0
+         do 40 ip=1,nfound
+            np=nlist(ip)
+            nmd=mod(abs(np-n),ncomp)
+            if(nmd.le.nmin.or.nmd.ge.ncomp-nmin) goto 40  ! temporal neighbours
+            nf=nf+1
+            dis=0
+            mcount=0
+            do 50 i=mt-1,0,-1
+               do 50 is=1,mmax
+                  mcount=mcount+1
+                  if(mcount.gt.m) goto 2
+ 50               dis=max(dis,abs(y(n-i*id,is)-y(np-i*id,is)))
+ 2          d(nf)=dis
+ 40         continue
+         if(nf.lt.k) then
+            iunp=iunp+1                                   ! mark for next sweep
+            ju(iunp)=n
+         else
+            e=which(nf,d,k,nwork)
+            eln=eln+log(max(e,tiny))
+         endif
+ 30      continue
+      iu=iunp
+      eps=eps*sqrt(2.)
+      if(iunp.ne.0) goto 1
+      eln=eln/(ncmin-(mt-1)*id)
+      end
+
+c digamma function
+c Copyright (C) T. Schreiber (1998)
+
+      function psi(i)
+      dimension p(0:20)
+      data p/0., 
+     .  -0.57721566490,  0.42278433509,  0.92278433509,  1.25611766843,
+     .   1.50611766843,  1.70611766843,  1.87278433509,  2.01564147795,
+     .   2.14064147795,  2.25175258906,  2.35175258906,  2.44266167997,
+     .   2.52599501330,  2.60291809023,  2.67434666166,  2.74101332832,
+     .   2.80351332832,  2.86233685773,  2.91789241329,  2.97052399224/
+
+      if(i.le.20) then
+         psi=p(i)
+      else
+         psi=log(real(i))-1/(2.*i)
+      endif
+      end
+
+
+
+
+
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/endtoend.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/endtoend.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,120 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   endtoend.f
+c   Determine end-to-end mismatch before making surrogate data
+c   author T. Schreiber (1999)
+c===========================================================================
+
+      parameter(nx=100000,mx=20)
+      dimension x(nx,mx), icol(mx)
+      character*72 file, fout
+      data iverb/15/
+
+      call whatido("Determine end-to-end mismatch",iverb)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      wjump=fcan("j",0.5)
+      mcmax=ican("m",0)
+      call columns(mc,mx,icol)
+      if(mcmax.eq.0) mcmax=max(1,mc)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call xreadfile(nmax,mcmax,nx,x,nexcl,icol,file,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_end")
+      call outfile(fout,iunit,iverb)
+      nmaxp=nmax
+      etotm=mcmax
+ 1    nmaxp=nless(nmaxp)
+      call jump(nmax,nmaxp,nx,x,mcmax,wjump,etot,ejump,eslip,njump)
+      if(etot.lt.etotm) then
+         etotm=etot
+         write(iunit,'(a,i7,a,i7,a,f5.1,a)')
+     .      "length:", nmaxp, 
+     .      "  offset: ", nexcl+njump,
+     .      "  lost: ", real(nmax-nmaxp)/real(nmax)*100, " %"
+         write(iunit,*) "      jump: ", ejump*100, " %"
+         write(iunit,*) "      slip: ", eslip*100, " %" 
+         write(iunit,*) "  weighted: ", etot*100, " %"
+         write(iunit,'()')
+      endif
+      if(etot.lt.1e-5) stop
+      nmaxp=nmaxp-1
+      if(nmaxp.gt.2) goto 1
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-j# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("j","weight given to jump relative to slip (0.5)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("m","number of columns to be read (1)")
+      call popt("c","columns to be read (1)")
+      call pout("file_end")
+      call pall()
+      stop
+      end
+
+      subroutine jump(nmax,nmaxp,nx,x,mcmax,wjump,etot,ejump,eslip,
+     .   njump)
+c loop through time ofsets to minimize jump effect
+      dimension x(nx,*)
+
+      etot=mcmax
+      do 10 nj=0,nmax-nmaxp
+         xj=0
+         sj=0
+         do 20 m=1,mcmax
+            xj=xj+xjump(nmaxp,x(1+nj,m))
+ 20         sj=sj+sjump(nmaxp,x(1+nj,m))
+         if(wjump*xj+(1-wjump)*sj.ge.etot) goto 10
+         etot=wjump*xj+(1-wjump)*sj
+         ejump=xj
+         eslip=sj
+         njump=nj
+ 10      continue
+      end
+
+      function xjump(nmax,x)
+c contribution of end effect to 1st derivative
+      dimension x(*)
+
+      call rms(nmax,x,sc,sd)
+      xjump=0
+      if(sd.eq.0.) return
+      xjump=(x(1)-x(nmax))**2/(nmax*sd**2)
+      end
+
+      function sjump(nmax,x)
+c contribution of end effect to 2nd derivative
+      dimension x(*)
+
+      call rms(nmax,x,sc,sd)
+      sjump=0
+      if(sd.eq.0.) return
+      sjump=((x(nmax)-x(nmax-1))-(x(2)-x(1)))**2 / (nmax*sd**2)
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/events.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/events.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,65 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   events.f
+c   convert inter-event intervals to event times
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file, fout
+      data iverb/1/
+
+      call whatido("interval to event time conversion",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         nmax=nmax+1
+         do 20 n=nmax,2,-1
+ 20         x(n)=x(n-1)
+         x(1)=0
+         do 30 n=2,nmax
+ 30         x(n)=x(n)+x(n-1)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_st")
+ 10      call writefile(nmax,x,fout,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_st")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/gpl.txt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/gpl.txt	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,21 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/help.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/help.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,80 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   help.f
+c   Utilities for usage message
+c   author T. Schreiber (1998)
+c===========================================================================
+      subroutine whatido(text,iverb)
+      character*72 progname
+      character*(*) text
+
+      call getarg(0,progname)
+      call argdel(0)
+      iverb=igetv(iverb)
+      if(iv_io(iverb).eq.1) then
+         write(istderr(),'()')  
+         write(istderr(),'(a)') 
+     .              "TISEAN 3.0.1 (C) R. Hegger, H. Kantz, T. Schreiber
+     .(1998-2007)"
+         write(istderr(),'()')  
+         write(istderr(),'(a,a,a)') 
+     .      progname(1:index(progname," ")-1), ": ", text
+      endif
+      if(lopt("h",1).eq.1) call usage()
+      end
+
+      subroutine whatineed(text)
+      character*72 progname
+      character*(*) text
+
+      call getarg(0,progname)
+      write(istderr(),'()') 
+      write(istderr(),'(a,a,x,a)') 
+     .   "Usage: ", progname(1:index(progname," ")-1),  text
+      end
+
+      subroutine popt(c,text)
+      character*(*) c,text
+
+      write(istderr(),'(5h    -,a,x,1h<,a,1h>)') c, text
+      end
+
+      subroutine ptext(text)
+      character*(*) text
+
+      write(istderr(),'(3x,a)') text
+      end
+
+      subroutine pout(text)
+      character*(*) text
+
+      write(istderr(),'(8h    -o <,a,a,1h>)') 
+     .   "output file name, just -o means ", text
+      end
+
+      subroutine pall()
+
+      call popt("V","verbosity level (0 = only fatal errors)")
+      call popt("h","show this message")
+      write(istderr(),'()')
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/henon.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/henon.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,69 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   henon.f
+c   iterate Henon map
+c   author Thomas Schreiber (1998)
+c===========================================================================
+      double precision xo, yo, xn, yn, a, b
+      character*72 fout
+      data a/1.4/,b/0.3/,ntrans/10000/,xo/.68587/,yo/.65876/
+      data iverb/1/
+
+      call whatido("Henon map",iverb)
+      nmax=imust('l')
+      ntrans=ican('x',ntrans)
+      a=fcan('A',real(a))
+      b=fcan('B',real(b))
+      xo=fcan('X',real(xo))
+      yo=fcan('Y',real(yo))
+      isout=igetout(fout,iverb)
+
+      if(isout.eq.1) fout="henon.dat"
+      call outfile(fout,iunit,iverb)
+      n=-ntrans
+ 1    n=n+1
+      xn=1.-a*xo**2+b*yo
+      yn=xo
+      xo=xn
+      yo=yn
+      if(n.lt.1) goto 1
+      write(iunit,*) real(xn), real(yn)
+      if(nmax.eq.0.or.n.lt.nmax) goto 1
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-l# [-A# -B# -X# -Y# -o outfile -x# -V# -h]")
+      call popt("l","number of points x,y (l=0: infinite)")
+      call popt("A","parameter a (1.4)")
+      call popt("B","parameter b (0.3)")
+      call popt("X","initial x")
+      call popt("Y","initial y")
+      call popt("x","number of transients discarded (10000)")
+      call pout("henon.dat")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/ikeda.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/ikeda.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,75 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   ikeda.f
+c   iterate Ikeda map
+c   author Thomas Schreiber (1998)
+c===========================================================================
+      double precision xo, yo, xn, yn, a, b, c, s, cs, ss
+      character*72 fout
+      data a/0.4/,b/6.0/,c/0.9/,
+     .   ntrans/10000/,xo/.68587/,yo/.65876/
+      data iverb/1/
+
+      call whatido("Ikeda map",iverb)
+      nmax=imust('l')
+      ntrans=ican('x',ntrans)
+      a=fcan('A',real(a))
+      b=fcan('B',real(b))
+      c=fcan('C',real(c))
+      xo=fcan('X',real(xo))
+      yo=fcan('Y',real(yo))
+      isout=igetout(fout,iverb)
+
+      if(isout.eq.1) fout="ikeda.dat"
+      call outfile(fout,iunit,iverb)
+      n=-ntrans
+ 1    n=n+1
+      s=a-b/(1.+xo**2+yo**2)
+      cs=cos(s)
+      ss=sin(s)
+      xn=1.+c*(xo*cs-yo*ss)
+      yn=c*(xo*ss+yo*cs)
+      xo=xn
+      yo=yn
+      if(n.lt.1) goto 1
+      write(iunit,*) real(xn), real(yn)
+      if(nmax.eq.0.or.n.lt.nmax) goto 1
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-l# [-A# -B# -C# -R# -I# -o outfile -x# -V# -h]")
+      call popt("l","number of points x,y (l=0: infinite)")
+      call popt("A","parameter a (0.4)")
+      call popt("B","parameter b (6.0)")
+      call popt("C","parameter c (0.9)")
+      call popt("R","initial Re(z)")
+      call popt("I","initial Im(z)")
+      call popt("x","number of transients discarded (10000)")
+      call pout("ikeda.dat")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/intervals.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/intervals.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,62 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   intervals.f
+c   convert event times to inter-event intervals
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file, fout
+      data iverb/1/
+
+      call whatido("event time to interval conversion",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         nmax=nmax-1
+         do 20 n=1,nmax
+ 20         x(n)=x(n+1)-x(n)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_ss")
+ 10      call writefile(nmax,x,fout,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_ss")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/istdio_temp.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/istdio_temp.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,44 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   istdio_temp.f
+c   standard input-output unit assignments for TISEAN f-sources
+c
+      function istderr()
+      istderr=ERRUNIT
+      end
+
+      function istdin()
+      istdin=5
+      end
+
+      function istdout()
+      istdout=6
+      end
+
+      function ifilein()
+      ifilein=10
+      end
+
+      function ifileout()
+      ifileout=11
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/lazy.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/lazy.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,109 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   lazy.f
+c   simple nonlinear noise reduction
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997,2004)
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx), x0(nx), xc(nx)
+      character*72 file, fout
+      data eps/0./, frac/0./, imax/1/
+      data iverb/1/
+
+      call whatido("simple nonlinear noise reduction",iverb)
+      m=imust("m")
+      eps=fcan("r",eps)
+      frac=fcan("v",frac)
+      imax=ican("i",imax)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+      if(eps.eq.0.and.frac.eq.0.) call usage()
+
+      call nthstring(1,file)
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_l")
+      call rms(nmax,x,sc,sd)
+      if(frac.gt.0) eps=sd*frac
+      do 10 n=1,nmax
+ 10      x0(n)=x(n)
+      do 20 it=1,imax
+         call nrlazy(nmax,x,xc,m,eps)
+         if(fout.ne." ".or.isout.eq.1.or.it.eq.imax) then
+            if(isout.eq.1) call suffix(fout,"c")
+            call outfile(fout,iunit,iverb)
+            do 30 n=1,nmax
+ 30            write(iunit,*) xc(n), x0(n)-xc(n)
+            if(iunit.ne.istdout()) close(iunit)
+            if(iv_io(iverb).eq.1) call writereport(nmax,fout)
+         endif
+         eps=0
+         do 40 n=1,nmax
+            eps=eps+(xc(n)-x(n))**2
+ 40         x(n)=xc(n)          
+         eps=sqrt(eps/nmax)
+         if(eps.eq.0.) then
+            if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .      'Zero correction, finished'
+            stop
+         endif
+ 20      if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .      'New diameter of neighbourhoods is ', eps
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-m# [-r# | -v#] [-i# -o outfile -l# -x# -c# -V# -h] file")
+      call ptext("either -r or -v must be present")
+      call popt("m","embedding dimension")
+      call popt("r","absolut radius of neighbourhoods")
+      call popt("v","same as fraction of standard deviation")
+      call popt("i","number of iterations (1)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_lc,  file_lcc (etc.)")
+      call pall()
+      stop
+      end
+
+      subroutine nrlazy(nmax,y,yc,m,eps)
+      parameter(im=100,ii=100000000,nx=1000000) 
+      dimension y(nmax),yc(nmax),jh(0:im*im),jpntr(nx),nlist(nx)
+
+      if(nmax.gt.nx) stop "nrlazy: make nx larger."
+      call base(nmax,y,1,m,jh,jpntr,eps)
+      do 10 n=1,nmax
+ 10      yc(n)=y(n)   
+      do 20 n=m,nmax           
+         call neigh(nmax,y,y,n,nmax,1,m,jh,jpntr,eps,nlist,nfound)
+         av=0
+         do 30 nn=1,nfound            
+ 30         av=av+y(nlist(nn)-(m-1)/2)              ! average middle coordinate
+ 20      yc(n-(m-1)/2)=av/nfound
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/lorenz.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/lorenz.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,311 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   lorenz.f
+c   integrates the Lorenz system with Runge Kutta fourth order
+c   author: H. Kantz (2007) based on earlier versions
+c   with optional noise
+c===========================================================================
+c
+
+      real*8 x(3),u(3,3),sliap(3),bb,ss,rr,r1,r2,dh,s
+      character*72 fout
+      data iverb/1/
+
+      iverb=ican('V',iverb)
+      call whatido("integration of the Lorenz system",iverb)
+      irun=imust('l')
+      itrans=ican('x',100)
+      rr=fcan('R',28.0)
+      ss=fcan('S',10.0)
+      bb=fcan('B',2.666666667)
+      isamp=ican('f',100)
+      sn=fcan('r',0.)
+c      ilyap=lopt('L',1)
+
+      isout=igetout(fout,iverb)
+
+      if(isout.eq.1) fout="lorenz.dat"
+      call outfile(fout,iunit,iverb)
+
+cc intermittency parameters
+c       ss=10.d0
+c       rr=166.11d0
+c       bb=8.d0/3.d0
+
+      iseed1=6456423
+      iseed2=7243431
+
+      xav=0.
+      xsq=0.
+      rsq=0.
+
+c     step width of Runge Kutta integration dh:
+      dh=.0005d0
+c     time intervals between re-orthogonalization of tangent space
+c            vectors: 0.01 units of time.
+      ireno=.01d0/dh
+c     length of transient in iteration steps:
+      itrans=real(itrans)/dh
+      totaltime=real(irun)/real(isamp)
+      istep=1.d0/dh/isamp
+
+      if (iverb.eq.1) 
+     . write(istderr(),*)'Lorenz trajectory covering',totaltime,
+     .                  ' time units'
+
+c      x(1)=sqrt(s*(r+1.d0))+2.
+c      x(2)=x(1)-1.d0
+c      x(3)=r
+
+      x(1)=5.
+      x(2)=-10.
+      x(3)=3.
+
+      do 1 i=1,3
+       sliap(i)=0.d0
+       do j=1,3
+        u(i,j)=0.d0
+       enddo
+       u(i,i)=1.d0
+1     continue
+
+      do 10 i2=1,itrans
+
+        call RUKU(3,x,u,dh,bb,ss,rr)
+
+        if (mod(i2,ireno).eq.0) then
+          call norm(u,1,s)
+          do i=2,3
+            do j=1,i-1
+              call proj(u,i,j)
+            enddo
+           call NORM(u,i,s)
+          enddo
+        endif
+
+10    continue
+
+      write(iunit,101)x(1),x(2),x(3)
+
+ 100  continue
+      do 20 i2=1,irun*istep
+c       add noise
+        if (sn.gt.0.0) then
+          call gauss(r1,r2,iseed1,iseed2)
+          x(1)=x(1)+r1*sn
+          x(2)=x(2)+r2*sn
+          call gauss(r1,r2,iseed1,iseed2)
+          x(3)=x(3)+r1*sn
+          xav=xav+x(1)
+          xsq=xsq+x(1)**2
+          rsq=rsq+r1*r1
+        endif
+        call RUKU(3,x,u,dh,bb,ss,rr)
+        if (mod(i2,istep).eq.0) write(iunit,101)x(1),x(2),x(3)
+        if (mod(i2,ireno).eq.0) then 
+c         Gram Schmidt Orthonormierung
+          call norm(u,1,s)
+          sliap(1)=sliap(1)+log(s)
+          do i=2,3
+            do j=1,i-1
+             call proj(u,i,j)
+            enddo
+            call NORM(u,i,s)
+            sliap(i)=sliap(i)+log(s)
+          enddo
+        endif
+
+ 20   continue
+
+      if (sn.gt.0.0) then
+        xav=xav/irun/istep
+        xsq=xsq/irun/istep
+        rsq=rsq/irun/istep
+        rlevel=sqrt(rsq)/sqrt(xsq-xav*xav)*100.
+        if (iverb.eq.1) 
+     .   print*,'noise level in percent of x-coordinate',rlevel
+      endif
+      if (iverb.eq.1) then
+       write(istderr(),*)
+       write(istderr(),*)'Lyapunov exponents [1/unit time]'
+       do i=1,3
+        write(istderr(),*)real(sliap(i)/totaltime)
+       enddo
+      endif
+
+ 101  format(2x,3f10.3)
+
+      stop
+      end
+
+      subroutine FORCE(x,ff,dh,bb,ss,rr)
+      real*8 x(3),ff(3),dh,bb,ss,rr
+
+        ff(1)=dh*ss*(x(2)-x(1))
+        ff(2)=dh*(x(1)*(-x(3)+rr)-x(2))
+        ff(3)=dh*(x(1)*x(2)-bb*x(3))
+
+      return
+      end
+
+      subroutine LFORCE(x,u,fl,dh,bb,ss,rr)
+      real*8 x(3),u(3,3),dh,fl(3,3),bb,ss,rr
+
+       do j=1,3
+         fl(j,1)=dh*ss*(u(j,2)-u(j,1))
+         fl(j,2)=dh*(u(j,1)*(rr-x(3))-x(1)*u(j,3)-u(j,2))
+         fl(j,3)=dh*(u(j,1)*x(2)+x(1)*u(j,2)-bb*u(j,3))
+       enddo
+      return
+      end
+
+      subroutine RUKU(n,x,u,dh,bb,ss,rr)
+c     4th-order Runge Kutta
+c     initial point x
+c     final point y
+c     stepsize dh
+c     add subroutine force
+      
+      implicit real*8 (a-h,o-z)
+      real*8 x(3),ff1(3),ff2(3),ff3(3),ff4(3),dummy(3)
+      real*8 u(3,3),fl1(3,3),fl2(3,3),fl3(3,3),fl4(3,3)
+      real*8 dl(3,3)
+
+      call force(x,ff1,dh,bb,ss,rr)
+      call LFORCE(x,u,fl1,dh,bb,ss,rr)
+
+      do i=1,n
+      dummy(i)=ff1(i)*.5d0+x(i)
+        do j=1,3
+        dl(i,j)=fl1(i,j)*.5d0+u(i,j)
+        enddo
+      enddo
+
+      call force(dummy,ff2,dh,bb,ss,rr)
+      call LFORCE(dummy,dl,fl2,dh,bb,ss,rr)
+
+      do i=1,n
+      dummy(i)=ff2(i)*.5d0+x(i)
+        do j=1,3
+        dl(i,j)=fl2(i,j)*.5d0+u(i,j)
+        enddo
+      enddo
+
+      call force(dummy,ff3,dh,bb,ss,rr)
+      call LFORCE(dummy,dl,fl3,dh,bb,ss,rr)
+
+      do i=1,n
+      dummy(i)=ff3(i)+x(i)
+        do j=1,3
+        dl(i,j)=fl3(i,j)+u(i,j)
+        enddo
+      enddo
+
+      call force(dummy,ff4,dh,bb,ss,rr)
+      call LFORCE(dummy,dl,fl4,dh,bb,ss,rr)
+
+      do i=1,n
+      x(i)=x(i)+ff1(i)/6.d0+ff2(i)/3.d0+ff3(i)/3.d0+ff4(i)/6.d0
+        do j=1,3
+        u(i,j)=u(i,j)+fl1(i,j)/6.d0+fl2(i,j)/3.d0+fl3(i,j)/3.d0
+     +               +fl4(i,j)/6.d0
+        enddo
+      enddo
+
+      return
+      end
+
+      subroutine NORM(u,i,s)
+      real*8 u(3,3),s
+
+      s=0.d0
+      do 10 j=1,3
+10    s=s+u(i,j)**2
+      s=sqrt(s)
+      si=1.d0/s
+      do 20 j=1,3
+20    u(i,j)=u(i,j)*si
+      return
+      end
+
+      subroutine PROJ(u,i,j)
+      real*8 u(3,3),s
+      s=0.d0
+      do 10 k=1,3
+10      s=s+u(i,k)*u(j,k)
+      do 20 k=1,3
+20      u(i,k)=u(i,k)-s*u(j,k)
+      return
+      end
+
+c>-------------------------------------------------------
+      subroutine gauss(r1,r2,iseed1,iseed2)
+
+      real*8 r1,r2,p,phi,r
+      pii=8.d0*atan(1.d0)
+
+      call RANDOM1(p,iseed1)
+      call RANDOM1(phi,iseed2)
+       
+      phi=phi*pii
+      r=sqrt(-log(1.d0-p)*2.d0)
+
+      r1=r*sin(phi)
+      r2=r*cos(phi)
+      return
+      end
+c>-------------------------------------------------------
+      subroutine RANDOM1(r,iseed)
+c
+c     random number generator of Park & Miller
+c     random numbers in [0,1] !!!
+      real*8 r
+      integer*8 ia,im,ix
+      ia=7**5
+      im=2147483647
+      ix=iseed
+      ix=mod(ia*ix,im)
+      r=dfloat(ix)/dfloat(im)
+      iseed=ix
+      return
+      end
+c>------------------------------------------------------------------
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-l# [-f# -r# -R# -S# -B# -o outfile -x# -V# -h]")
+      call popt("l","length of trajectory x,y,z")
+      call popt("f","sample points per unit time [100]")
+      call popt("r","absolute noise amplitute [0]")
+      call popt("R","parameter r [28]")
+      call popt("S","parameter sigma [10]")
+      call popt("B","parameter b [8/3]")
+      call popt("x","transient discarded [100 units of time]")
+c      call popt("L","if present: compute Lyapunov exponents")
+      call pout("lorenz.dat")
+      call pall()
+      stop
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/neigh.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/neigh.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,182 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   utilities for neighbour search
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997)
+c   author T. Schreiber (1999)
+c   last modified H. Kantz Feb.2007
+c===========================================================================
+      subroutine base(nmax,y,id,m,jh,jpntr,eps)
+      parameter(im=100,ii=100000000) 
+      dimension y(nmax),jh(0:im*im),jpntr(nmax)
+
+      do 10 i=0,im*im
+ 10      jh(i)=0
+      do 20 n=(m-1)*id+1,nmax                                  ! make histogram
+         i=mod(int(y(n)/eps)+ii,im)
+         if(m.gt.1) i=im*i+mod(int(y(n-(m-1)*id)/eps)+ii,im)
+ 20      jh(i)=jh(i)+1
+      do 30 i=1,im*im                                           ! accumulate it
+ 30      jh(i)=jh(i)+jh(i-1)
+      do 40 n=(m-1)*id+1,nmax                           ! fill list of pointers
+
+         i=mod(int(y(n)/eps)+ii,im)
+         if(m.gt.1) i=im*i+mod(int(y(n-(m-1)*id)/eps)+ii,im)
+         jpntr(jh(i))=n
+ 40      jh(i)=jh(i)-1
+      end
+
+      subroutine neigh(nmax,y,x,n,nlast,id,m,jh,jpntr,eps,nlist,nfound)
+      parameter(im=100,ii=100000000) 
+      dimension y(nmax),x(nmax),jh(0:im*im),jpntr(nmax),nlist(nmax)
+
+      nfound=0
+      kloop=1
+      if(m.eq.1) kloop=0
+      jj=int(y(n)/eps)
+
+      kk=int(y(n-(m-1)*id)/eps)
+      do 10 j=jj-1,jj+1                               ! scan neighbouring boxes
+         do 20 k=kk-kloop,kk+kloop
+            jk=mod(j+ii,im)
+            if(m.gt.1) jk=im*jk+mod(k+ii,im)
+            do 30 ip=jh(jk+1),jh(jk)+1,-1               ! this is in time order
+               np=jpntr(ip)
+               if(np.gt.nlast) goto 20
+               do 40 i=0,m-1
+ 40               if(abs(y(n-i*id)-x(np-i*id)).ge.eps) goto 30
+               nfound=nfound+1
+               nlist(nfound)=np                       ! make list of neighbours
+ 30            continue
+ 20         continue
+ 10      continue
+      end
+
+c versions for multivariate series
+c author T. Schreiber (1999)
+
+      subroutine mbase(nmax,mmax,nxx,y,id,m,jh,jpntr,eps)
+      parameter(im=100,ii=100000000) 
+      dimension y(nxx,mmax),jh(0:im*im),jpntr(nmax)
+
+      if(mmax.eq.1) then
+         call base(nmax,y,id,m,jh,jpntr,eps)
+         return
+      endif
+      mt=(m-1)/mmax+1
+      do 10 i=0,im*im
+ 10      jh(i)=0
+      do 20 n=(mt-1)*id+1,nmax                                 ! make histogram
+        i=im*mod(int(y(n,1)/eps)+ii,im)+mod(int(y(n,mmax)/eps)+ii,im)
+ 20     jh(i)=jh(i)+1
+      do 30 i=1,im*im                                          ! accumulate it
+ 30     jh(i)=jh(i)+jh(i-1)
+      do 40 n=(mt-1)*id+1,nmax                          ! fill list of pointers
+        i=im*mod(int(y(n,1)/eps)+ii,im)+mod(int(y(n,mmax)/eps)+ii,im)
+        jpntr(jh(i))=n
+ 40     jh(i)=jh(i)-1
+      end
+
+      subroutine mneigh(nmax,mmax,nxx,y,n,nlast,id,m,jh,jpntr,eps,
+     .   nlist,nfound)
+      parameter(im=100,ii=100000000) 
+      dimension y(nxx,mmax),jh(0:im*im),jpntr(nmax),nlist(nmax)
+
+      if(mmax.eq.1) then
+         call neigh(nmax,y,y,n,nlast,id,m,jh,jpntr,eps,nlist,nfound)
+         return
+      endif
+      mt=(m-1)/mmax+1
+      nfound=0
+      jj=int(y(n,1)/eps)
+      kk=int(y(n,mmax)/eps)
+      do 10 j=jj-1,jj+1                               ! scan neighbouring boxes
+         do 20 k=kk-1,kk+1
+            jk=im*mod(j+ii,im)+mod(k+ii,im)
+            do 30 ip=jh(jk+1),jh(jk)+1,-1               ! this is in time order
+               np=jpntr(ip)
+               if(np.gt.nlast) goto 20
+               mcount=0
+               do 40 i=mt-1,0,-1
+                  do 40 is=1,mmax
+                     mcount=mcount+1
+                     if(mcount.gt.m) goto 1
+ 40                  if(abs(y(n-i*id,is)-y(np-i*id,is)).ge.eps) goto 30
+ 1             nfound=nfound+1
+               nlist(nfound)=np                       ! make list of neighbours
+ 30            continue
+ 20         continue
+ 10      continue
+      end
+c>---------------------------------------------------------------------
+c modified version for multivariate series
+c author H. Kantz (2004)
+
+      subroutine mneigh2(nmax,mdim,y,nx,vx,jh,jpntr,eps,
+     .   nlist,nfound)
+c
+c     search neighbours for vx among the set of all y's
+c     multivariate: mmax: spatial dimension
+c     no additional delay!
+      parameter(im=100,ii=100000000) 
+      dimension y(nx,mdim),jh(0:im*im),jpntr(nmax),nlist(nmax)
+      dimension vx(mdim)
+
+      nfound=0
+      jj=int(vx(1)/eps)
+      kk=int(vx(mdim)/eps)
+      do 10 j=jj-1,jj+1                               ! scan neighbouring boxes
+         do 20 k=kk-1,kk+1
+            jk=im*mod(j+ii,im)+mod(k+ii,im)
+            do 30 ip=jh(jk+1),jh(jk)+1,-1               ! this is in time order
+               np=jpntr(ip)
+c               if(np.gt.nlast) goto 20
+               mcount=0
+                  do 40 is=1,mdim
+ 40                  if(abs(vx(is)-y(np,is)).ge.eps) goto 30
+ 1             nfound=nfound+1
+               nlist(nfound)=np                       ! make list of neighbours
+ 30            continue
+ 20         continue
+ 10      continue
+      end
+
+      subroutine mbase2(nmax,mmax,nxx,y,jh,jpntr,eps)
+      parameter(im=100,ii=100000000) 
+      dimension y(nxx,mmax),jh(0:im*im),jpntr(nmax)
+
+      if(mmax.eq.1) then
+         call base(nmax,y,id,m,jh,jpntr,eps)
+         return
+      endif
+      do 10 i=0,im*im
+ 10      jh(i)=0
+      do 20 n=1,nmax                                 ! make histogram
+        i=im*mod(int(y(n,1)/eps)+ii,im)+mod(int(y(n,mmax)/eps)+ii,im)
+ 20     jh(i)=jh(i)+1
+      do 30 i=1,im*im                                          ! accumulate it
+ 30     jh(i)=jh(i)+jh(i-1)
+      do 40 n=(mmax-1)*id+1,nmax                      ! fill list of pointers
+        i=im*mod(int(y(n,1)/eps)+ii,im)+mod(int(y(n,mmax)/eps)+ii,im)
+        jpntr(jh(i))=n
+ 40     jh(i)=jh(i)-1
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/nmore.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/nmore.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,58 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   utilities for TISEAN f-sources
+c
+      function nmore(n)
+c find smallest factorisable number .ge.n
+
+      nmore=n
+ 1    if(isfact(nmore).eq.1) return
+      nmore=nmore+1
+      goto 1
+      end
+
+      function nless(n)
+c find largest factorisable number .le.n
+
+      nless=n
+ 1    if(isfact(nless).eq.1) return
+      nless=nless-1
+      goto 1
+      end
+
+      function isfact(n)
+c determine if n is factorisable using the first nprimes primes
+      parameter(nprimes=3)
+      dimension iprime(nprimes)
+      data iprime/2,3,5/
+
+      isfact=1
+      ncur=n
+ 1    if(ncur.eq.1) return
+      do 10 i=1,nprimes
+         if(mod(ncur,iprime(i)).eq.0) then
+            ncur=ncur/iprime(i)
+            goto 1
+         endif
+ 10      continue
+      isfact=0
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/normal.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/normal.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,70 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   utilities for normalisation of time series
+c   author T. Schreiber (1998)
+c===========================================================================
+      subroutine rms(nmax,x,sc,sd)
+c  return mean sc and rms amplitude sd
+      dimension x(nmax)
+
+      sc=0.
+      do 10 n=1,nmax
+ 10      sc=sc+x(n)
+      sc=sc/nmax
+      sd=0.
+      do 20 n=1,nmax
+ 20      sd=sd+(x(n)-sc)**2
+      sd=sqrt(sd/nmax)
+      end
+
+      subroutine normal(nmax,x,sc,sd)
+c  subtract mean, return mean sc and rms amplitude sd
+      dimension x(nmax)
+
+      call rms(nmax,x,sc,sd)
+      do 10 n=1,nmax
+ 10      x(n)=x(n)-sc
+      end
+
+      subroutine normal1(nmax,x,sc,sd)
+c  subtract mean, rescale to unit variance, 
+c  return mean sc and rms amplitude sd
+      dimension x(nmax)
+
+      call rms(nmax,x,sc,sd)
+      if(sd.eq.0.) stop 
+     .   "normal1: zero variance, cannot normalise"
+      do 10 n=1,nmax
+ 10      x(n)=(x(n)-sc)/sd
+      end
+
+      subroutine minmax(nmax,x,xmin,xmax)
+c  obtain smallest and  largest value in x
+      dimension x(nmax)
+
+      xmin=x(1)
+      xmax=x(1)
+      do 10 n=2,nmax
+         xmin=min(x(n),xmin)
+ 10      xmax=max(x(n),xmax)
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/notch.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/notch.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,86 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   notch filter in the time domain
+c   author T. Schreiber
+c===========================================================================
+
+      parameter(nx=1000000)
+      dimension x(nx), y(nx)
+      character*72 file, fout
+      data h/1./, w/0.01/, pi/3.1415926/
+      data iverb/1/
+
+      call whatido("notch filter",iverb)
+      f=fmust("X")
+      h=fcan("f",h)
+      w=fcan("w",w)
+      fw=tan(pi*f/h)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         d=fnotch(nmax,x,y,fw,w)
+         if(isout.eq.1) call addsuff(fout,file,"_notch")
+ 10      call writefile(nmax,y,fout,iverb)
+      end
+
+      function fnotch(nmax,x,y,fw,w)
+      dimension x(nmax), y(nmax)
+
+      a=(1+w*fw)**2+fw**2
+      c0=   (1+fw**2)/a
+      c1=-2*(1-fw**2)/a
+      c2=c0
+      d1= 2*(1-w**2*fw**2-fw**2)/a
+      d2=  -((1-w*fw)**2+fw**2)/a
+
+      y(1)=c0*x(1)
+      y(2)=c0*x(2)+c1*x(1)+d1*y(1)
+      do 10 n=3,nmax
+ 10      y(n)=c0*x(n)+c1*x(n-1)+c2*x(n-2)+d1*y(n-1)+d2*y(n-2)
+      fnotch=0
+      do 20 n=1,nmax
+ 20      fnotch=fnotch+(x(n)-y(n))**2
+      fnotch=sqrt(fnotch/nmax)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-X# [-f# -w# -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("X","frequency to be cancelled")
+      call popt("f","sampling rate of data (1)")
+      call popt("w","width of filter (f/100)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_notch")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/pc.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/pc.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,96 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   embed using principal components
+C   author Thomas Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000, me=500)
+      dimension x(nx), c(me,me), d(me), xc(me), z(me,me)
+      character*72 file, fout
+      data id/1/, isvd/2/
+      data iverb/1/
+
+      call whatido("embed using principal components",iverb)
+      m=imust("m")
+      if(m.gt.me) stop "svd: make me larger."
+      id=ican("d",id)
+      isvd=min(ican("q",isvd),m)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      call normal(nmax,x,sc,sd)
+      call svd_vectors(nmax,m,id,x,c,z,d)
+      if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .   "#, fraction of variance, accumulative fraction"
+      ctot=0.
+      do 10 i=1,m
+ 10      ctot=ctot+d(m+1-i)
+      cacc=0.
+      do 20 i=1,m
+         cacc=cacc+d(m+1-i)
+ 20      if(iv_io(iverb).eq.1) 
+     .      write(istderr(),*) i, d(m+1-i)/ctot, cacc/ctot
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_pc")
+      call outfile(fout,iunit,iverb)
+      do 30 n=(m-1)*id+1,nmax
+         do 40 i=1,isvd
+            s=0
+            do 50 j=1,m
+ 50            s=s+z(j,m+1-i)*x(n-(j-1)*id)
+ 40         xc(i)=s
+ 30      write(iunit,*) (xc(i),i=1,isvd)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-m# [-d# -q# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("m","initial embedding dimension")
+      call popt("d","delay for initial embedding (1)")
+      call popt("q","number of principal components (2)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_pc")
+      call pall()
+      stop
+      end
+
+      subroutine svd_vectors(nmax,m,id,x,c,z,d)
+      parameter(me=500)
+      dimension x(nmax), c(me,*), d(m), w1(me), w2(me), z(me,*)
+  
+      if(m.gt.me) stop "svd_vectors: make me larger."
+      do 10 i=1,m
+         do 10 j=i,m
+            s=0.
+            do 20 n=(m-1)*id+1,nmax
+ 20            s=s+x(n-(i-1)*id)*x(n-(j-1)*id)
+            c(i,j)=s/(nmax-(m-1)*id)
+ 10         c(j,i)=c(i,j)
+      call rs(me,m,c,d,1,z,w1,w2,ierr)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/predict.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/predict.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,104 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   simple nonlinear prediction, fast neighbour search
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997,2004)
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx), y(nx)
+      character*72 file, fout
+      data eps/0./, frac/0./, ifc/1/
+      data iverb/1/
+
+      call whatido("prediction with locally constant fits",iverb)
+      id=imust("d")
+      m=imust("m")
+      eps=fcan("r",eps)
+      frac=fcan("v",frac)
+      ifc=ican("s",ifc)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+      if(eps.eq.0.and.frac.eq.0.) call usage()
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_pred")
+         call rms(nmax,x,sc,sd)
+         if(frac.gt.0) eps=sd*frac
+         iun=istdout()
+         if(fout.eq." ") iun=istderr()
+         write(iun,*) "err: ", fcerror(nmax,x,y,m,id,ifc,eps), 
+     .      " "//file(1:index(file," ")-1)
+ 10      call writefile(nmax,y,fout,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-d# -m# [-r# | -v#]"//
+     .   " [-s# -o outfile -l# -x# -c# -V# -h] file(s)")
+      call ptext("either -r or -v must be present")
+      call popt("d","delay")
+      call popt("m","embedding dimension")
+      call popt("r","absolute radius of neighbourhoods")
+      call popt("v","same as fraction of standard deviation")
+      call popt("s","time steps ahead forecast (one step)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_pred")
+      call pall()
+      stop
+      end
+
+      function fcerror(nmax,y,yp,m,id,ifc,eps)
+      parameter(im=100,ii=100000000,nx=1000000) 
+      dimension y(nmax),yp(nx),jh(0:im*im),jpntr(nx),nlist(nx)
+
+      if(nmax.gt.nx) stop "fcerror: make nx larger."
+      call base(nmax-ifc,y,id,m,jh,jpntr,eps)
+      fcerror=0
+
+      call rms(nmax,y,sx,sd)
+      do 10 n=1,(m-1)*id+ifc
+ 10      yp(n)=sx
+      do 20 n=(m-1)*id+1,nmax-ifc           
+         call neigh(nmax,y,y,n,nmax,id,m,jh,jpntr,eps,nlist,nfound)
+         av=0
+         do 30 nn=1,nfound            
+ 30         if(nlist(nn).ne.n) av=av+y(nlist(nn)+ifc) 
+         if(nfound.gt.1) then
+            yp(n+ifc)=av/(nfound-1)
+         else
+            yp(n+ifc)=sx
+         endif
+ 20      fcerror=fcerror+(y(n+ifc)-yp(n+ifc))**2
+      fcerror=sqrt(fcerror/(nmax-ifc-(m-1)*id))
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/project.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/project.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,172 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   nonlinear noise reduction
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997,2004)
+c   authors T. Schreiber, H. Kantz, R. Hegger (1998) based on earlier versions
+c===========================================================================
+      parameter(nx=100000)
+      dimension x(nx), x0(nx), xc(nx)
+      character*72 file, fout
+      data imax/1/
+      data iverb/1/
+
+      call whatido("nonlinear noise reduction (see also: noise)",iverb)
+      m=imust("m")
+      nq=m-imust("q")
+      eps=fmust("r",eps)
+      kmin=imust("k")
+      imax=ican("i",imax)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_")
+
+      do 10 n=1,nmax
+ 10      x0(n)=x(n)
+      do 20 it=1,imax
+         call clean(nmax,x,xc,m,kmin,nq,eps,iverb)
+         if(fout.ne." ".or.isout.eq.1.or.it.eq.imax) then
+            if(isout.eq.1) call suffix(fout,"c")
+            call outfile(fout,iunit,iverb)
+            do 30 n=1,nmax
+ 30            write(iunit,*) xc(n), x0(n)-xc(n)
+            if(iunit.ne.istdout()) close(iunit)
+            if(iv_io(iverb).eq.1) call writereport(nmax,fout)
+         endif
+         eps=0
+         do 40 n=1,nmax
+            eps=eps+(xc(n)-x(n))**2
+ 40         x(n)=xc(n)
+         eps=sqrt(eps/nmax)
+ 20      if(iv_io(iverb).eq.1) 
+     .      write(istderr(),*) 'New diameter of neighbourhoods is ', eps
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-m# -q# -r# -k# [-i# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("m","embedding dimension")
+      call popt("q","dimension of manifold")
+      call popt("r","radius of neighbourhoods")
+      call popt("k","minimal number of neighbours")
+      call popt("i","number of iterations (1)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_c, file_cc (etc.)")
+      call pall()
+      call ptext("Verbosity levels (add what you want):")
+      call ptext("          1 = input/output" )
+      call ptext("          2 = state of neighbour search")
+      write(istderr(),'()') 
+      stop
+      end
+
+      subroutine clean(nmax,y,yc,m,kmin,nq,d,iverb)
+      parameter(im=100,ii=100000000,nx=100000,mm=15,small=0.0001) 
+      dimension y(nmax),yc(nmax),r(mm),ju(nx),c(mm,mm),cm(mm),
+     .  jh(0:im*im),jpntr(nx),nlist(nx), zcm(mm,nx)
+
+      if(nmax.gt.nx.or.m.gt.mm) stop "clean: make mm/nx larger."
+      sr=2*small+m-2                                        ! ${\rm tr}(1/r)=1$
+      do 10 i=1,m
+         r(i)=sr
+ 10      if(i.eq.m.or.i.eq.1) r(i)=sr/small
+      do 20 i=1,nmax
+ 20      yc(i)=y(i)
+      do 30 istep=1,2
+         eps=d
+         iu=nmax-m+1
+         do 40 i=1,iu
+ 40         ju(i)=i+m-1
+ 1       call base(nmax,y,1,m,jh,jpntr,eps)
+         iunp=0
+         do 50 nn=1,iu                                        ! find neighbours
+            n=ju(nn)
+            call neigh(nmax,y,y,n,nmax,1,m,jh,jpntr,eps,nlist,nfound)
+            if(nfound.lt.kmin) then               ! not enough neighbours found
+               iunp=iunp+1                                ! mark for next sweep
+               ju(iunp)=n
+            else                                      ! fine: enough neighbours
+               do 90 i=1,m                              ! centre of mass vector
+                  s=0
+                  do 100 np=1,nfound
+ 100                 s=s+y(nlist(np)-m+i)
+ 90               cm(i)=s/nfound
+               if(istep.eq.1) then                  ! just store centre of mass
+                  do 110 i=1,m
+ 110                 zcm(i,n)=cm(i)
+               else
+                  do 120 i=1,m                ! corrected centre of mass vector
+                     s=0
+                     do 130 np=1,nfound
+ 130                    s=s+zcm(i,nlist(np))
+ 120                 cm(i)=2*cm(i)-s/nfound
+                  do 140 i=1,m                      ! compute covariance matrix
+                     do 140 j=i,m
+                        s=0
+                        do 150 np=1,nfound
+                           jm=nlist(np)-m
+ 150                       s=s+(y(jm+i)-cm(i))*(y(jm+j)-cm(j))
+                        c(i,j)=r(i)*r(j)*s/nfound
+ 140                    c(j,i)=c(i,j)
+                 call eigen(c,m)               ! find eigenvectors (decreasing)
+                 do 160 i=1,m
+                    s=0
+                    do 170 iq=m-nq+1,m
+                       do 170 j=1,m
+ 170                      s=s+(y(n-m+j)-cm(j))*c(i,iq)*c(j,iq)*r(j)
+ 160                yc(n-m+i)=yc(n-m+i)-s/r(i)/r(i)
+               endif
+            endif
+ 50         continue
+         iu=iunp
+         if(iv_uncorr(iverb).eq.1) 
+     .      write(istderr(),*) "With ", eps, iunp, " uncorrected"
+         eps=eps*sqrt(2.)
+ 30      if(iunp.ne.0) goto 1
+      end
+
+c driver for diagonalisation routines
+c see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997)
+c Copyright (C) T. Schreiber (1997)
+
+      subroutine eigen(c,kk)
+      parameter(md=15)
+      dimension c(md,md),d(md),w1(md),w2(md),z(md,md)
+      if(kk.gt.md) stop "eigen: make md larger."
+
+      call rs(md,kk,c,d,1,z,w1,w2,ierr)
+      do 10 i=1,kk
+         do 10 j=1,kk
+ 10         c(i,j)=z(i,kk+1-j)
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/Makefile.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/Makefile.in	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,53 @@
+SHELL = /bin/sh
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+BINDIR = ${exec_prefix}/@bindir@
+
+FC = @FC@
+FFLAGS = @FFLAGS@
+INSTALL = @INSTALL@
+LDFLAGS = @LDFLAGS@
+
+LOADLIBES = ../libtsa.a ../libsla.a
+
+SRC = randomize.f cost/$(COST).o cool/$(COOL).o perm/$(PERM).o
+TRG = randomize_$(COST)_$(COOL)_$(PERM)
+
+all install clean missing uninstall:
+	-$(MAKE) COST=auto      COOL=exp PERM=random $@-one
+	-$(MAKE) COST=autop     COOL=exp PERM=random $@-one
+	-$(MAKE) COST=spikeauto COOL=exp PERM=random $@-one
+	-$(MAKE) COST=spikespec COOL=exp PERM=event  $@-one
+	-$(MAKE) COST=uneven    COOL=exp PERM=random $@-one
+# add more similar lines for each module you have written
+# for example if you created cost/mycost.f
+#	-$(MAKE) COST=mycost  COOL=exp PERM=random $@-one
+
+install-one: $(TRG)
+	-$(INSTALL) $(TRG) $(BINDIR)
+
+missing-one:
+	-@$(TRG) -h 2>&1 | cat >>  ../../install.log
+	-@test -z "`$(TRG) -h 2>&1 | grep Usage`" \
+	   && echo $(TRG) "(Wuppertal Fortran)" >>  ../../missing.log; :
+
+uninstall-one:
+	-@rm -f $(BINDIR)/$(TRG)
+
+clean-one: 
+	@rm -f $(TRG)
+
+all-one: $(TRG)
+
+$(TRG): $(SRC)
+	-$(FC) $(FFLAGS) $(SRC) -o $(TRG) $(LOADLIBES) $(LDFLAGS)
+
+cost/$(COST).o: cost/$(COST).f
+	$(FC) $(FFLAGS) -c cost/$(COST).f -o cost/$(COST).o
+
+cool/$(COOL).o: cool/$(COOL).f
+	$(FC) $(FFLAGS) -c cool/$(COOL).f -o cool/$(COOL).o
+
+perm/$(PERM).o: perm/$(PERM).f
+	$(FC) $(FFLAGS) -c perm/$(PERM).f -o perm/$(PERM).o
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cool/exp.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cool/exp.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,127 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the randomize-package for constraint surrogates
+c   exponential cooling scheme
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get options specific for cooling scheme
+C
+      subroutine opts_cool()
+      common /coolcom/ 
+     .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
+
+      tini=fcan("T",0.)
+      afac=fcan("a",0.)
+      mtot=ican("S",20000)
+      msucc=ican("s",2000)
+      mstop=ican("z",200)
+      cgoal=fcan("C",0.)
+      end
+
+c-------------------------------------------------------------------
+c print version information on cooling scheme
+C
+      subroutine what_cool()
+      call ptext("Cooling scheme: exponential")
+      end
+
+c-------------------------------------------------------------------
+c print usage message specific for cooling scheme
+C
+      subroutine usage_cool()
+      call ptext("Cooling options: [-T# -a# -S# -s# -z# -C#]")
+      call popt("T","initial temperature (auto)")
+      call popt("a","cooling factor (auto)")
+      call popt("S","total steps before cooling (20000)")
+      call popt("s","successful steps before cooling (2000)")
+      call popt("z","minimal successful steps before cooling (200)")
+      call popt("C","goal value of cost function (0.0)")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cooling scheme
+C
+      function cool_init()
+      common /coolcom/ 
+     .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
+
+      ntot=0
+      nsucc=0
+      itini=1
+      if(tini.eq.0.) then
+         tini=1e-4
+         itini=0
+      endif
+      iafac=1
+      if(afac.eq.0.) then
+         afac=0.5
+         iafac=0
+      endif
+      temp=tini
+      cool_init=temp
+      end
+      
+c-------------------------------------------------------------------
+c determine new temperature depending on current cost function,
+c acceptance status and history
+c par can be used to pass information to the permutation scheme
+c
+      function cool(iaccept,iend,iv)
+      common /coolcom/ 
+     .   itini,tini,iafac,afac,cgoal,mtot,msucc,ntot,nsucc,mstop
+      common nmax,cost,temp,cmin,rate
+
+      iend=0
+      cool=temp
+      nsucc=nsucc+iaccept
+      ntot=ntot+1
+      if(ntot.lt.mtot.and.nsucc.lt.msucc) return
+      rate=real(nsucc)/real(ntot)
+      iend=1
+      if(cost.le.cgoal) return
+      if(itini.eq.0.and.temp.eq.tini.and.ntot.gt.1.5*nsucc) then
+         tini=10*temp
+         if(iv.ne.0) write(istderr(),*) 
+     .      "increased initial temperature from ",
+     .      temp, " to ", tini, " for melting"
+         temp=tini
+      else if(nsucc.le.mstop) then
+         if(iafac.eq.1) return
+         afac=sqrt(afac)
+         mtot=mtot*sqrt(2.)
+         temp=tini
+         if(iv.ne.0) write(istderr(),*) "starting over: "
+         if(iv.ne.0) write(istderr(),*) "   Cooling rate: ", afac, 
+     .      " S:", mtot, " s: ", msucc
+      else         
+         temp=temp*afac
+         if(iv.ne.0) write(istderr(),
+     .      '(3hT: ,g15.6,4h S: ,i15,4h s: , i15,8h  cost: ,g15.6)') 
+     .      temp, ntot, nsucc, cost
+      endif
+      iend=0
+      ntot=0
+      nsucc=0
+      cool=temp
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cost/auto.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cost/auto.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,174 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   cost function
+c   autocorrelation function
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get cost function specific options
+c
+      subroutine opts_cost(ncol)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      
+      nlag=imust('D')
+      iweight=ican('W',0)
+      ncol=1
+      end
+
+c-------------------------------------------------------------------
+c print version information on cost function
+c
+      subroutine what_cost()
+      call ptext("Cost function: autocorrelation")
+      end
+
+c-------------------------------------------------------------------
+c print cost function specific usage message
+c
+      subroutine usage_cost()
+      call ptext("Cost function options: -D# [-W#]")
+      call popt("D","number of lags")
+      call popt("W",
+     .   "average: 0=max(c) 1=|c|/lag 2=(c/lag)**2 3=max(c)/lag (0)")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cost function
+c
+      subroutine cost_init()
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+
+      if(nlag.gt.mlag) write(istderr(),'(a)') 
+     .   "truncated to ", mlag," lags"
+      nlag=min(mlag,nlag)
+      call auto(nlag,c0)
+      end
+
+c-------------------------------------------------------------------
+c initial transformation on time series and its inverse
+c
+      subroutine cost_transform(nmax,mcmax,nxdum,x)
+      dimension x(nmax)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+
+      call normal1(nmax,x,sc,sd)
+      end
+
+      subroutine cost_inverse(nmax,mcmax,nxdum,x,y)
+      dimension x(nmax), y(nmax)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      
+      do 10 n=1,nmax
+ 10      y(n)=x(n)*sd+sc
+      end
+
+c-------------------------------------------------------------------
+c compute full cost function from scratch
+c
+      subroutine cost_full(iv)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax,cost
+
+      call auto(nlag,c)
+      cc=0
+      do 10 n=1,nlag
+ 10      call aver(cc,c0(n)-c(n),n)
+      cost=cc
+      end
+
+c-------------------------------------------------------------------
+c compute changed cost function on exchange of n1 and n2 
+c
+      subroutine cost_update(nn1,nn2,cmax,iaccept,iv)
+      parameter(mlag=100000,nx=100000)
+      dimension c0(mlag), c(mlag), ccop(mlag), x(nx)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax,cost,temp,cmin,rate,x
+
+      n1=min(nn1,nn2)
+      n2=max(nn1,nn2)
+      comp=0
+      iaccept=0
+      do 10 n=1,nlag
+         cc=c(n)
+         dx=x(n2)-x(n1)
+         if(n1-n.ge.1) cc=cc+dx*x(n1-n)
+         if(n2+n.le.nmax) cc=cc-dx*x(n2+n)
+         if(n2-n1.eq.n) goto 1
+         if(n1+n.le.nmax) cc=cc+dx*x(n1+n)
+         if(n2-n.ge.1) cc=cc-dx*x(n2-n)
+ 1       call aver(comp,c0(n)-cc,n)
+         if(comp.ge.cmax) return
+ 10      ccop(n)=cc
+      cost=comp  ! if got here: accept
+      iaccept=1
+      call exch(n1,n2)
+      do 20 n=1,nlag
+ 20      c(n)=ccop(n)
+      end
+
+c-------------------------------------------------------------------
+c compute autocorrelation from scratch
+c
+      subroutine auto(nlag,c)
+      parameter(nx=100000)
+      dimension c(*), x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      do 10 n=1,nlag
+         cc=0
+         do 20 i=n+1,nmax
+ 20         cc=cc+x(i-n)*x(i)
+ 10      c(n)=cc
+      end
+
+c-------------------------------------------------------------------
+c weighted average of autocorrelation 
+c
+      subroutine aver(cav,dc,n)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax
+
+      if(iweight.eq.0) then
+         cav=max(cav,abs(dc)/real(nmax-n))
+      else if(iweight.eq.1) then
+         cav=cav+abs(dc)/real((nmax-n)*n)
+      else if(iweight.eq.2) then
+         cav=cav+(dc/real((nmax-n)*n))**2
+      else
+         cav=max(cav,abs(dc)/real((nmax-n)*n))
+      endif
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cost/autop.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cost/autop.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,181 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   cost function 
+c   autocorrelation function with periodic continuation
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get cost function specific options
+c
+      subroutine opts_cost(ncol)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      
+      nlag=imust('D')
+      iweight=ican('W',0)
+      ncol=1
+      end
+
+c-------------------------------------------------------------------
+c print version information on cost function
+c
+      subroutine what_cost()
+      call ptext("Cost function: periodic autocorrelation")
+      end
+
+c-------------------------------------------------------------------
+c print cost function specific usage message
+c
+      subroutine usage_cost()
+      call ptext("Cost function options: -D# [-W#]")
+      call popt("D","number of lags")
+      call popt("W",
+     .   "average: 0=max(c) 1=|c|/lag 2=(c/lag)**2 3=max(c)/lag (0)")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cost function
+c
+      subroutine cost_init()
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+
+      if(nlag.gt.mlag) write(istderr(),'(a)') 
+     .   "truncated to ", mlag," lags"
+      nlag=min(mlag,nlag)
+      call auto(nlag,c0)
+      end
+
+c-------------------------------------------------------------------
+c initial transformation on time series and its inverse
+c
+      subroutine cost_transform(nmax,mcmax,nxdum,x)
+      dimension x(nmax)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+
+      call normal1(nmax,x,sc,sd)
+      end
+
+      subroutine cost_inverse(nmax,mcmax,nxdum,x,y)
+      dimension x(nmax), y(nmax)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      
+      do 10 n=1,nmax
+ 10      y(n)=x(n)*sd+sc
+      end
+
+c-------------------------------------------------------------------
+c compute full cost function from scratch
+c
+      subroutine cost_full(iv)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax,cost
+
+      call auto(nlag,c)
+      cc=0
+      do 10 n=1,nlag
+ 10      call aver(cc,c0(n)-c(n),n)
+      cost=cc
+      end
+
+c-------------------------------------------------------------------
+c compute changed cost function on exchange of n1 and n2 
+c
+      subroutine cost_update(n1,n2,cmax,iaccept,iv)
+      parameter(mlag=100000,nx=100000)
+      dimension c0(mlag), c(mlag), ccop(mlag), x(nx)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax,cost,temp,cmin,rate,x
+
+      comp=0
+      iaccept=0
+      do 10 n=1,nlag
+         cc=c(n)
+         dx=x(n2)-x(n1)
+         nd1=n1-n
+         if(nd1.lt.1) nd1=nd1+nmax
+         if(nd1.ne.n2) cc=cc+dx*x(nd1)
+         nu1=n1+n
+         if(nu1.gt.nmax) nu1=nu1-nmax
+         if(nu1.ne.n2) cc=cc+dx*x(nu1)
+         nd2=n2-n
+         if(nd2.lt.1) nd2=nd2+nmax
+         if(nd2.ne.n1) cc=cc-dx*x(nd2)
+         nu2=n2+n
+         if(nu2.gt.nmax) nu2=nu2-nmax
+         if(nu2.ne.n1) cc=cc-dx*x(nu2)
+         call aver(comp,c0(n)-cc,n)
+         if(comp.ge.cmax) return
+ 10      ccop(n)=cc
+      cost=comp  ! if got here: accept
+      iaccept=1
+      call exch(n1,n2)
+      do 20 n=1,nlag
+ 20      c(n)=ccop(n)
+      end
+
+c-------------------------------------------------------------------
+c compute autocorrelation from scratch
+c
+      subroutine auto(nlag,c)
+      parameter(nx=100000)
+      dimension c(*), x(nx)
+      common nmax,cost,temp,cmin,rate,x
+      
+      do 10 n=1,nlag
+         cc=0
+         do 20 i=1,nmax
+            ii=i-n
+            if(ii.lt.1) ii=ii+nmax
+ 20         cc=cc+x(ii)*x(i)
+ 10      c(n)=cc
+      end
+
+c-------------------------------------------------------------------
+c weighted average of autocorrelation 
+c
+      subroutine aver(cav,dc,n)
+      parameter(mlag=100000)
+      dimension c0(mlag), c(mlag)
+      common /costcom/ nlag, c0, c, sd, sc, iweight
+      common nmax
+
+      if(iweight.eq.0) then
+         cav=max(cav,abs(dc)/real(nmax))
+      else if(iweight.eq.1) then
+         cav=cav+abs(dc)/real(nmax*n)
+      else if(iweight.eq.2) then
+         cav=cav+(dc/real(nmax*n))**2
+      else
+         cav=max(cav,abs(dc)/real(nmax*n))
+      endif
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cost/spikeauto.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cost/spikeauto.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,265 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   cost function
+c   binned spike train autocorrelation function
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get cost function specific options
+c
+      subroutine opts_cost(ncol)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+
+      iweight=ican('W',0)
+      bininv=1./fmust("d")
+      totbin=fmust("D")
+      nbin=min(int(totbin*bininv)+1,nhist)
+      inter=lopt("i",1)
+      ncol=1
+      end
+
+c-------------------------------------------------------------------
+c print version information on cost function
+c
+      subroutine what_cost()
+      call ptext("Cost function: spike train autocorrelation function")
+      end
+
+c-------------------------------------------------------------------
+c print cost function specific usage message
+c
+      subroutine usage_cost()
+      call ptext("Cost function options: -d# -D# [-i -W#]")
+      call popt("d","time span of one bin")
+      call popt("D","total time spanned")
+      call popt("i","expect intervals rather than times")
+      call popt("W",
+     .   "average: 0=max(c) 1=|c|/lag 2=(c/lag)**2 (0)")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cost function
+c
+      subroutine cost_init()
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+
+      call sauto(nbin,bininv,ihist0)
+      end
+
+c-------------------------------------------------------------------
+c initial transformation on time series and its inverse
+c here: series internally stored as intervals 
+c
+      subroutine cost_transform(nmax,mcmax,nxdum,x)
+      parameter(nx=100000)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+      dimension nxclu(nx)
+      common /permutecom/ mxclu, nxclu
+      dimension x(*), lx(nx)
+
+      if(inter.eq.1) return
+      call sort(nmax,x,lx)
+      do 10 n=nmax,2,-1
+ 10      x(n)=x(n)-x(n-1)
+      mxclu=mxclu+1
+      nxclu(mxclu)=1
+      end
+
+      subroutine cost_inverse(nmax,mcmax,nxdum,x,y)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+      dimension x(*), y(*)
+      
+      do 10 n=1,nmax
+ 10      y(n)=x(n)
+      if(inter.eq.1) return
+      do 20 n=2,nmax
+ 20      y(n)=y(n)+y(n-1)
+      end
+
+c-------------------------------------------------------------------
+c compute full cost function from scratch
+c
+      subroutine cost_full(iv)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+      common nmax,cost
+
+      call sauto(nbin,bininv,ihist)
+      cost=aver(ihist0,ihist)
+      if(iv.ne.0) call dump()
+      end
+
+c-------------------------------------------------------------------
+c compute changed cost function on exchange of n1 and n2 
+c
+      subroutine cost_update(nn1,nn2,cmax,iaccept,iv)
+      parameter(nx=100000)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+      dimension ihcop(nhist), x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      n1=min(nn1,nn2)
+      n2=max(nn1,nn2)
+      comp=0
+      iaccept=0
+      do 10 i=1,nbin
+ 10      ihcop(i)=ihist(i)
+      dx=0
+      do 20 nn=n1,1,-1
+         if(nn.lt.n1) dx=dx+x(nn)
+         if(int(dx*bininv)+1.gt.nbin) goto 1
+         dxx=dx
+         do 30 nnn=n1,n2-1
+            dxx=dxx+x(nnn)
+            il=int(dxx*bininv)+1
+            if(il.gt.nbin) goto 20
+ 30         ihcop(il)=ihcop(il)-1
+ 20      continue
+ 1    dx=0
+      do 40 nn=n2,1,-1
+         if(nn.lt.n2) dx=dx+x(nn)
+         if(int(dx*bininv)+1.gt.nbin) goto 2
+         dxx=dx
+         do 50 nnn=n2,nmax
+            dxx=dxx+x(nnn)
+            il=int(dxx*bininv)+1
+            if(il.gt.nbin) goto 40
+ 50         ihcop(il)=ihcop(il)-1
+ 40      continue
+ 2    call exch(n1,n2)
+      dx=0
+      do 60 nn=n1,1,-1
+         if(nn.lt.n1) dx=dx+x(nn)
+         if(int(dx*bininv)+1.gt.nbin) goto 3
+         dxx=dx
+         do 70 nnn=n1,n2-1
+            dxx=dxx+x(nnn)
+            il=int(dxx*bininv)+1
+            if(il.gt.nbin) goto 60
+ 70         ihcop(il)=ihcop(il)+1
+ 60      continue
+ 3    dx=0
+      do 80 nn=n2,1,-1
+         if(nn.lt.n2) dx=dx+x(nn)
+         if(int(dx*bininv)+1.gt.nbin) goto 4
+         dxx=dx
+         do 90 nnn=n2,nmax
+            dxx=dxx+x(nnn)
+            il=int(dxx*bininv)+1
+            if(il.gt.nbin) goto 80
+ 90         ihcop(il)=ihcop(il)+1
+ 80      continue
+ 4    comp=aver(ihist0,ihcop)
+      if(comp.ge.cmax) then
+         call exch(n1,n2)
+         return
+      endif
+      cost=comp  ! if got here: accept
+      iaccept=1
+      if(iv.ne.0) call panic(ihcop)
+      do 100 i=1,nbin
+ 100     ihist(i)=ihcop(i)
+      end
+
+c-------------------------------------------------------------------
+c compute autocorrealtion from scratch
+c
+      subroutine sauto(nbin,bininv,ihist)
+      parameter(nx=100000)
+      dimension ihist(*)
+      common nmax,cost,temp,cmin,rate,x
+      dimension x(nx)
+
+      do 10 i=1,nbin
+ 10      ihist(i)=0
+      do 20 n1=1,nmax
+         dx=0
+         do 30 n2=n1,nmax
+            dx=dx+x(n2)
+            il=int(dx*bininv)+1
+            if(il.gt.nbin) goto 20
+ 30         ihist(il)=ihist(il)+1
+ 20      continue
+      end
+
+c-------------------------------------------------------------------
+c weighted average of autocorrelation 
+c
+      function aver(ih1,ih2)
+      parameter(nhist=100000)
+      dimension ih1(nhist), ih2(nhist)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+
+      aver=0
+      if(iweight.eq.0) then
+         do 10 i=1,nbin
+ 10         aver=max(aver,real(abs(ih1(i)-ih2(i))))
+      else if(iweight.eq.1) then
+         do 20 i=1,nbin
+ 20         aver=aver+real(abs(ih1(i)-ih2(i)))/real(i)
+      else if(iweight.eq.2) then
+         do 30 i=1,nbin
+ 30         aver=aver+(ih1(i)-ih2(i))**2/real(i)
+      endif
+      end
+
+c-------------------------------------------------------------------
+c diagnostic output
+c
+      subroutine dump()
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+
+      write(istderr(),'(5hgoal ,4i12)') (ihist0(n),n=1,min(4,nbin))
+      write(istderr(),'(5his   ,4i12)') (ihist(n),n=1,min(4,nbin))
+      write(istderr(),'(5hmiss ,4i12)') 
+     .   (abs(ihist0(n)-ihist(n)),n=1,min(4,nbin))
+      write(istderr(),'()')
+      end
+
+      subroutine panic(ihcop)
+      parameter(nhist=100000)
+      dimension ihist0(nhist), ihist(nhist)
+      common /costcom/ inter, bininv, nbin, ihist0, ihist, iweight
+      dimension ihcop(*)
+
+      call cost_full(0)
+      write(istderr(),'(7hupdate ,4i12)') (ihcop(n),n=1,min(4,nbin))
+      write(istderr(),'(7hfresh  ,4i12)') (ihist(n),n=1,min(4,nbin))
+      write(istderr(),'(7hdiscr  ,4i12)') 
+     .   (abs(ihcop(n)-ihist(n)),n=1,min(4,nbin))
+      write(istderr(),'()')
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cost/spikespec.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cost/spikespec.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,251 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   cost function
+c   spike train power spectrum
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get cost function specific options
+c
+      subroutine opts_cost(ncol)
+      parameter(mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+
+      iweight=ican('W',0)
+      fmax=fcan("F",0)
+      nfreq=ican("#",0)
+      inter=lopt("i",1)
+      ncol=1
+      end
+
+c-------------------------------------------------------------------
+c print version information on cost function
+c
+      subroutine what_cost()
+      call ptext("Cost function: spike train power spectrum")
+      end
+
+c-------------------------------------------------------------------
+c print cost function specific usage message
+c
+      subroutine usage_cost()
+      call ptext("Cost function options: [-F# -## -w# -i]")
+      call popt("W",
+     .   "average: 0=max(s) 1=|s|/f 2=(s/f)**2 3=|s| (0)")
+      call popt("F","maximal frequency (2*l / total time)")
+      call popt("#","number of frequencies (F* total time /2)")
+      call popt("w","frequency resolution (0)")
+      call popt("i","expect intervals rather than times")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cost function
+c
+      subroutine cost_init()
+      parameter(nx=100000,mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      dimension x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      if(fmax.le.0.) fmax=2*nmax/(x(nmax)-x(1))
+      if(nfreq.le.0) nfreq=fmax*(x(nmax)-x(1))/2
+      if(nfreq.gt.mfreq) write(istderr(),'(a)') 
+     .   "truncated to ", mfreq," frequencies"
+      nfreq=min(mfreq,nfreq)
+      write(istderr(),*) "randomize_spikespec: total time covered: ", 
+     .   x(nmax)-x(1)
+      write(istderr(),*) "randomize_spikespec: computing ", nfreq, 
+     .   " frequencies up to ", fmax
+      call sspect(nfreq,fmax/nfreq,sp0r,sp0i,sp0)
+      end
+
+c-------------------------------------------------------------------
+c initial transformation on time series and its inverse
+c
+      subroutine cost_transform(nmax,mcmax,nxdum,x)
+      parameter(mfreq=100000,nx=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      dimension x(nx), lx(nx)
+
+      if(inter.eq.0) goto 1
+      do 10 n=2,nmax
+ 10      x(n)=x(n)+x(n-1)
+ 1    call sort(nmax,x,lx)
+      end
+
+      subroutine cost_inverse(nmax,mcmax,nxdum,x,y)
+      parameter(mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      dimension x(nmax), y(nmax)
+      
+      do 10 n=1,nmax
+ 10      y(n)=x(n)
+      if(inter.ne.1) return
+      do 20 n=nmax,2,-1
+ 20      y(n)=y(n)-y(n-1)
+      end
+
+c-------------------------------------------------------------------
+c compute full cost function from scratch
+c
+      subroutine cost_full(iv)
+      parameter(mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      common nmax,cost
+
+      call sspect(nfreq,fmax/nfreq,spr,spi,sp)
+
+      cc=0
+      do 10 i=1,nfreq
+ 10      call aver(cc,sp(i)-sp0(i),i)
+      cost=cc
+      if(iv.ne.0) call dump()
+      end
+
+c-------------------------------------------------------------------
+c compute changed cost function on exchange of n1 and n2 
+c
+      subroutine cost_update(n1,n2,cmax,iaccept,iv)
+      parameter(mfreq=100000,nx=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      dimension sprcop(mfreq), spicop(mfreq), spcop(mfreq), x(nx)
+      common nmax,cost,temp,cmin,rate,x
+      data pi/3.1415926/
+
+      comp=0
+      iaccept=0
+      do 10 i=1,nfreq
+         f=i*(fmax/nfreq)
+         omega=2*pi*f
+         xx=x(n1-1)+x(n1+1)-x(n1)
+         sprcop(i)=spr(i)-cos(omega*x(n1))+cos(omega*xx)
+         spicop(i)=spi(i)-sin(omega*x(n1))+sin(omega*xx)
+         spcop(i)=sprcop(i)**2+spicop(i)**2
+         call aver(comp,sp0(i)-spcop(i),i)
+ 10      if(comp.ge.cmax) return
+      cost=comp  ! if got here: accept
+      iaccept=1
+      call exch(n1,n2)
+      if(iv.ne.0) call panic(spcop)
+      do 20 i=1,nfreq
+         spr(i)=sprcop(i)
+         spi(i)=spicop(i)
+ 20      sp(i)=spcop(i)
+      end
+
+c-------------------------------------------------------------------
+c compute spectrum from scratch
+c
+      subroutine sspect(nfreq,fres,spr,spi,sp)
+      parameter(nx=100000)
+      dimension spr(*), spi(*), sp(*), x(nx)
+      common nmax,cost,temp,cmin,rate,x
+      data pi/3.1415926/
+
+      do 10 i=1,nfreq
+         f=i*fres
+         omega=2*pi*f
+         sr=0
+         si=0
+         do 20 n=1,nmax
+            sr=sr+cos(omega*x(n))
+ 20         si=si+sin(omega*x(n))
+         spr(i)=sr
+         spi(i)=si
+ 10      sp(i)=sr**2+si**2
+      end
+
+c-------------------------------------------------------------------
+c weighted average of autocorrelation 
+c
+      subroutine aver(cav,dc,n)
+      parameter(mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+
+      if(iweight.eq.0) then
+         cav=max(cav,abs(dc))    ! max (L-infinity) norm
+      else if(iweight.eq.1) then
+         cav=cav+abs(dc)/n       ! L-1 norm (sum of moduli), weighted by freq.
+      else if(iweight.eq.2) then
+         cav=cav+(dc/n)**2       ! L-2 norm (sum of squares), weighted by freq.
+      else if(iweight.eq.2) then
+         cav=cav+abs(dc)         ! L-1 norm (sum of moduli)
+      endif
+      end
+
+c-------------------------------------------------------------------
+c diagnostic output
+c
+      subroutine dump()
+      parameter(mfreq=100000)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      common nmax
+
+      write(istderr(),'(5hgoal ,4f9.3)') (sp0(n),n=1,min(4,nfreq))
+      write(istderr(),'(5his   ,4f9.3)') (sp(n),n=1,min(4,nfreq))
+      write(istderr(),'(5hmiss ,4f9.3)') 
+     .   ((sp0(n)-sp(n)),n=1,min(4,nfreq))
+      write(istderr(),'()')
+      end
+
+      subroutine panic(spcop)
+      parameter(mfreq=100000)
+      dimension spcop(*)
+      dimension sp0r(mfreq), sp0i(mfreq), spr(mfreq), spi(mfreq),
+     .   sp0(mfreq), sp(mfreq)
+      common /costcom/ nfreq, fmax, inter,
+     .    sp0r, sp0i, sp0, spr, spi, sp, sd, sc, iweight
+      common nmax
+
+      call cost_full(0)
+      write(istderr(),'(7hupdate ,4f9.3)') 
+     .   (spcop(n),n=1,min(4,nfreq))
+      write(istderr(),'(7hfresh  ,4f9.3)') (sp(n),n=1,min(4,nfreq))
+      write(istderr(),'(7hdiscr  ,4f9.3)') 
+     .   ((spcop(n)-sp(n)),n=1,min(4,nfreq))
+      write(istderr(),'()')
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/cost/uneven.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/cost/uneven.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,260 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   cost function
+c   binned autocorrelation function of unevenly sampled data
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get cost function specific options
+c
+      subroutine opts_cost(ncol)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      character*80 filet
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+
+      iweight=ican('W',0)
+      bininv=1./fmust("d")
+      totbin=fmust("D")
+      nbin=min(int(totbin*bininv)+1,nhist)
+      ncol=2
+      end
+
+c-------------------------------------------------------------------
+c print version information on cost function
+c
+      subroutine what_cost()
+      call ptext("Cost function: binned autocorrelation function")
+      end
+
+c-------------------------------------------------------------------
+c print cost function specific usage message
+c
+      subroutine usage_cost()
+      call ptext("Cost function options: -d# -D# [-W#]")
+      call popt("d","time span of one bin")
+      call popt("D","total time spanned")
+      call popt("W",
+     .   "average: 0=max(c) 1=|c|/lag 2=(c/lag)**2 (0)")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for cost function
+c
+      subroutine cost_init()
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist), x(nx,2)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+      common nmax,cost,temp,cmin,rate,x
+
+      do 10 i=1,nbin
+ 10      hnorm(i)=0.
+      do 20 n1=1,nmax
+         do 30 n2=n1,nmax
+            il=int((x(n2,2)-x(n1,2))*bininv)+1
+            if(il.gt.nbin) goto 20
+ 30         hnorm(il)=hnorm(il)+1.
+ 20      continue
+      do 40 i=1,nbin
+ 40      if(hnorm(i).gt.0.) hnorm(i)=1./hnorm(i)
+      call sauto(nbin,bininv,h0)
+      end
+
+c-------------------------------------------------------------------
+c initial transformation on time series and its inverse
+c here: sort by increasing sample times, no inversion necessary
+c also normalise to unit variance, zero mean
+c
+      subroutine cost_transform(nmax,mcmax,nxdum,x)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+      dimension x(nxdum,2), lx(nx)
+
+      call indexx(nmax,x(1,2),lx)
+      call index2sort(nmax,x(1,2),lx)
+      call index2sort(nmax,x,lx)
+      call normal1(nmax,x,sc,sd)
+      end
+
+      subroutine cost_inverse(nmax,mcmax,nxdum,x,y)
+      dimension x(nxdum,2), y(nxdum,2)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+
+      do 10 n=1,nmax
+         y(n,2)=x(n,2)
+ 10      y(n,1)=x(n,1)*sd+sc
+      end
+
+c-------------------------------------------------------------------
+c compute full cost function from scratch
+c
+      subroutine cost_full(iv)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+      common nmax,cost
+
+      call sauto(nbin,bininv,h)
+      cost=aver(h0,h)
+      if(iv.ne.0) call dump()
+      end
+
+c-------------------------------------------------------------------
+c compute changed cost function on exchange of n1 and n2 
+c
+      subroutine cost_update(nn1,nn2,cmax,iaccept,iv)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+      dimension hcop(nhist), x(nx,2)
+      common nmax,cost,temp,cmin,rate,x
+
+      n1=min(nn1,nn2)
+      n2=max(nn1,nn2)
+      comp=0
+      iaccept=0
+      do 10 i=1,nbin
+ 10      hcop(i)=h(i)
+      do 20 nn=n1-1,1,-1
+         il=int((x(n1,2)-x(nn,2))*bininv)+1
+         if(il.gt.nbin) goto 1
+ 20      hcop(il)=hcop(il)-x(n1,1)*x(nn,1)
+ 1    continue
+      do 30 nn=n1,nmax
+         il=int((x(nn,2)-x(n1,2))*bininv)+1
+         if(il.gt.nbin) goto 2
+ 30      if(nn.ne.n2) hcop(il)=hcop(il)-x(nn,1)*x(n1,1)
+ 2    continue
+      do 40 nn=n2-1,1,-1
+         il=int((x(n2,2)-x(nn,2))*bininv)+1
+         if(il.gt.nbin) goto 3
+ 40      hcop(il)=hcop(il)-x(n2,1)*x(nn,1)
+ 3    continue
+      do 50 nn=n2,nmax
+         il=int((x(nn,2)-x(n2,2))*bininv)+1
+         if(il.gt.nbin) goto 4
+ 50      hcop(il)=hcop(il)-x(nn,1)*x(n2,1)
+ 4    call exch(n1,n2)
+      do 60 nn=n1-1,1,-1
+         il=int((x(n1,2)-x(nn,2))*bininv)+1
+         if(il.gt.nbin) goto 5
+ 60      hcop(il)=hcop(il)+x(n1,1)*x(nn,1)
+ 5    continue
+      do 70 nn=n1,nmax
+         il=int((x(nn,2)-x(n1,2))*bininv)+1
+         if(il.gt.nbin) goto 6
+ 70      if(nn.ne.n2) hcop(il)=hcop(il)+x(nn,1)*x(n1,1)
+ 6    continue
+      do 80 nn=n2-1,1,-1
+         il=int((x(n2,2)-x(nn,2))*bininv)+1
+         if(il.gt.nbin) goto 7
+ 80      hcop(il)=hcop(il)+x(n2,1)*x(nn,1)
+ 7    continue
+      do 90 nn=n2,nmax
+         il=int((x(nn,2)-x(n2,2))*bininv)+1
+         if(il.gt.nbin) goto 8
+ 90      hcop(il)=hcop(il)+x(nn,1)*x(n2,1)
+ 8    comp=aver(h0,hcop)
+      if(comp.ge.cmax) then
+         call exch(n1,n2)
+         return
+      endif
+      cost=comp  ! if got here: accept
+      iaccept=1
+      if(iv.ne.0) call panic(hcop)
+      do 100 i=1,nbin
+ 100     h(i)=hcop(i)
+      end
+
+c-------------------------------------------------------------------
+c compute autocorrealtion from scratch
+c
+      subroutine sauto(nbin,bininv,h)
+      parameter(nx=100000)
+      dimension h(*)
+      common nmax,cost,temp,cmin,rate,x
+      dimension x(nx,2)
+
+      do 10 i=1,nbin
+ 10      h(i)=0
+      do 20 n1=1,nmax
+         do 30 n2=n1,nmax
+            il=int((x(n2,2)-x(n1,2))*bininv)+1
+            if(il.gt.nbin) goto 20
+ 30         h(il)=h(il)+x(n2,1)*x(n1,1)
+ 20      continue
+      end
+
+c-------------------------------------------------------------------
+c weighted average of autocorrelation 
+c
+      function aver(h1,h2)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist), 
+     .   h1(*), h2(*)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+
+      aver=0
+      if(iweight.eq.0) then
+         do 10 i=1,nbin
+ 10         aver=max(aver,abs((h1(i)-h2(i))*hnorm(i)))
+      else if(iweight.eq.1) then
+         do 20 i=1,nbin
+ 20         aver=aver+abs((h1(i)-h2(i))*hnorm(i))/real(i)
+      else if(iweight.eq.2) then
+         do 30 i=1,nbin
+ 30         aver=aver+((h1(i)-h2(i))*hnorm(i))**2/real(i)
+      endif
+      end
+
+c-------------------------------------------------------------------
+c diagnostic output
+c
+      subroutine dump()
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+
+      write(istderr(),'(5hgoal ,4g15.5)') (h0(n),n=1,min(4,nbin))
+      write(istderr(),'(5his   ,4g15.5)') (h(n),n=1,min(4,nbin))
+      write(istderr(),'(5hmiss ,4g15.5)') 
+     .   (abs(h0(n)-h(n)),n=1,min(4,nbin))
+      write(istderr(),'()')
+      end
+
+      subroutine panic(hcop)
+      parameter(nhist=100000,nx=100000)
+      dimension hnorm(nhist), h0(nhist), h(nhist)
+      common /costcom/ bininv, nbin, hnorm, h0, h, sd, sc, iweight
+      dimension hcop(*)
+
+      call cost_full(0)
+      write(istderr(),'(7hupdate ,4g15.5)') (hcop(n),n=1,min(4,nbin))
+      write(istderr(),'(7hfresh  ,4g15.5)') (h(n),n=1,min(4,nbin))
+      write(istderr(),'(7hdiscr  ,4g15.5)') 
+     .   (abs(hcop(n)-h(n)),n=1,min(4,nbin))
+      write(istderr(),'()')
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/perm/event.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/perm/event.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,81 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+C   permutation scheme for event times
+c   one event time is changed such that the two adjacent intervals are swapped
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get permutation specific options
+c
+      subroutine opts_permute()
+      end
+
+c-------------------------------------------------------------------
+c print version information on permutation scheme
+c
+      subroutine what_permute()
+      call ptext("Permutation scheme: event time preserving intervals")
+      end
+
+c-------------------------------------------------------------------
+c print permutation specific usage message
+c
+      subroutine usage_permute()
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for permutation scheme 
+c
+      subroutine permute_init()
+      parameter(nx=100000) 
+      dimension x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      do 10 n=1,nmax*log(nmax*1.)
+         call permute(n1,n2)
+ 10      call exch(n1,n2)
+      end
+
+c-------------------------------------------------------------------
+c find two indices n1, n2 to be exchanged, maybe using a parameter 
+c par provided by the cooling schedule
+c
+c here, n2 is not used at all; event 1 and nmax are never changed
+c
+      subroutine permute(n1,n2)
+      common nmax
+      external rand
+
+      n1=min(int(rand(0.0)*nmax)+2,nmax-1)
+      end
+
+c-------------------------------------------------------------------
+c given two indices n1, n2, actually perform the exchange
+c
+      subroutine exch(n1,n2)
+      parameter(nx=100000)
+      dimension x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      x(n1)=x(n1-1)+x(n1+1)-x(n1)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/perm/random.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/perm/random.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,109 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   part of the TISEAN randomize package for constraint surrogates
+c   permutation scheme that swaps to randomly chosen data points
+c   this may also be used as a template for your own attempts
+c   author T. Schreiber (1999)
+c
+c-------------------------------------------------------------------
+c get permutation specific options
+c
+      subroutine opts_permute()
+      parameter(nx=100000)
+      dimension nxclu(nx)
+      character*80 filex
+      common /permutecom/ mxclu, nxclu
+
+      call stcan('X',filex,' ')
+      mxclu=0
+      if(filex.eq." ") return
+      open(10,file=filex,status="old",err=999)
+ 1    read(10,*,err=999,end=998) nn
+      mxclu=mxclu+1
+      nxclu(mxclu)=nn
+      goto 1
+ 998  return
+ 999  write(istderr(),'(a)') "permute: cannot open "//filex
+      stop
+      end
+
+c-------------------------------------------------------------------
+c print version information on permutation scheme
+c
+      subroutine what_permute()
+      call ptext("Permutation scheme: random pairs")
+      end
+
+c-------------------------------------------------------------------
+c print permutation specific usage message
+c
+      subroutine usage_permute()
+      call ptext("Permutation options: [-X xfile]")
+      call popt("X", "list of indices excluded from permutation")
+      end
+
+c-------------------------------------------------------------------
+c initialise all that is needed for permutation scheme 
+c
+      subroutine permute_init()
+      parameter(nx=100000)
+      dimension x(nx)
+      common nmax,cost,temp,cmin,rate,x
+      
+      if(nmax.gt.nx) stop "permute: make nx larger."
+      do 10 i=1,nmax
+         call permute(n1,n2)
+ 10      call exch(n1,n2)
+      end
+
+c-------------------------------------------------------------------
+c find two indices n1, n2 to be exchanged, maybe using a parameter 
+c par provided by the cooling schedule
+c
+      subroutine permute(n1,n2)
+      parameter(nx=100000)
+      dimension nxclu(nx)
+      common /permutecom/ mxclu, nxclu
+      common nmax
+      external rand
+
+ 1    n1=min(int(rand(0.0)*nmax)+1,nmax)
+      do 10 n=1,mxclu
+ 10      if(n1.eq.nxclu(n)) goto 1
+ 2    n2=min(int(rand(0.0)*nmax)+1,nmax)
+      if(n2.eq.n1) goto 2
+      do 20 n=1,mxclu
+ 20      if(n2.eq.nxclu(n)) goto 2
+      end
+
+c-------------------------------------------------------------------
+c given two indices n1, n2, actually perform the exchange
+c
+      subroutine exch(n1,n2)
+      parameter(nx=100000)
+      dimension x(nx)
+      common nmax,cost,temp,cmin,rate,x
+
+      h=x(n1)
+      x(n1)=x(n2)
+      x(n2)=h
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/randomize/randomize.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/randomize/randomize.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,127 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   constrained randomization
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=100000,mx=20) 
+      double precision time
+      dimension x(nx,mx), y(nx,mx), xx(nx,mx), icol(mx)
+      character*72 file, fout, comment
+      common nmax,cost,temp,cmin,rate,x
+      external rand
+      data wr/0.9/, nsur/1/
+      data iverb/15/
+
+      call whatido("constrained randomization",iverb)
+      call what_cost()
+      call what_cool()
+      call what_permute()
+      rr=rand(ican("I",0)/real(2**22))
+      nsur=min(999,ican("n",nsur))
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      mcmax=ican("m",0)
+      call columns(mc,mx,icol)
+      if(mcmax.eq.0) mcmax=max(1,mc)
+      wr=fcan("u",wr)
+      call opts_cost(mcmax)
+      call opts_cool()
+      call opts_permute()
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call xreadfile(nmax,mcmax,nx,xx,nexcl,icol,file,iverb)
+      call cost_transform(nmax,mcmax,nx,xx)
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_rnd")
+      if(nsur.gt.1) call suffix(fout,"_000")
+
+      do 10 isur=1,nsur
+         do 20 n=1,nmax
+            do 20 m=1,mcmax
+ 20            x(n,m)=xx(n,m)
+         rate=1
+         cost=r1mach(2)
+         cmin=cost
+         if(nsur.gt.1) write(fout(index(fout," ")-3:72),'(i3.3)') isur
+         temp=cool_init()
+         call cost_init()
+         call permute_init()
+         call cost_full(iv_vcost(iverb))
+         cmin=cost
+         time=0
+ 1       time=time+1.
+         call permute(n1,n2)
+         cmax=cost-temp*log(rand(0.0))    ! maximal acceptable cost
+         call cost_update(n1,n2,cmax,iaccept,iv_vmatch(iverb))
+         tnew=cool(iaccept,iend,iv_cool(iverb))
+         if(tnew.ne.temp.or.cost.lt.cmin*wr) then
+            cc=cost
+            call cost_full(iv_vcost(iverb))
+            if(iv_match(iverb).eq.1) write(istderr(),*) 
+     .         "cost function mismatch: ", abs((cc-cost)/cost)
+         endif
+         temp=tnew
+         if(cost.lt.cmin*wr) then
+            if(iv_cost(iverb).eq.1) write(istderr(),*) 
+     .         "after ",real(time)," steps at T=",temp," cost: ",cost
+            cmin=cost
+            call cost_inverse(nmax,mcmax,nx,x,y)
+            write(comment,'(8h# cost: ,g15.5)') cost
+            call xwritecfile(nmax,mcmax,nx,y,fout,iverb,comment)
+         endif
+         if(iend.ne.1) goto 1
+         write(comment,'(8h# cost: ,g15.5)') cost
+         call writecfile(nmax,mcmax,nx,y,fout,iverb,comment)
+ 10      continue
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed("[-n# -u# -I# -o outfile -l# -x# -c# -V# -h]"//
+     .   " [cost opt.] [cooling opt.] [permutation opt.] file")
+      call popt("n","number of surrogates (1)")
+      call popt("u","improvement factor before write (0.9)")
+      call popt("I","seed for random numbers (0)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_rnd(_nnn)")
+      call pall()
+      call ptext("Verbosity levels (add what you want):")
+      call ptext("          1 = input/output" )
+      call ptext("          2 = current cost if improved")
+      call ptext("          4 = cost mismatch")
+      call ptext("          8 = temperature etc. at cooling")
+      call ptext("         16 = verbose cost if improved")
+      call ptext("         32 = verbose cost mismatch")
+      write(istderr(),'()') 
+      call usage_cost()
+      write(istderr(),'()') 
+      call usage_cool()
+      write(istderr(),'()') 
+      call usage_permute()
+      write(istderr(),'()') 
+      stop
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/rank.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/rank.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,153 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   box assisted sorting/ranking utilities 
+c   author T. Schreiber (1998) based on earlier versions
+c===========================================================================
+      subroutine rank(nmax,x,list)
+c  rank points in x
+      parameter(nptr=100000)
+      dimension x(nmax), list(nmax), jptr(0:nptr)
+
+      call minmax(nmax,x,xmin,xmax)
+      if(xmin.eq.xmax) then
+         do 10 n=1,nmax
+ 10         list(n)=n
+         return
+      endif
+      nl=min(nptr,nmax/2)
+      sc=(nl-1)/(xmax-xmin)
+      do 20 i=0,nl
+ 20      jptr(i)=0
+      do 30 n=1,nmax
+         xn=x(n)
+         i=int((xn-xmin)*sc)
+         ip=jptr(i)
+         if ((ip.eq.0).or.(xn.le.x(ip))) then
+            jptr(i)=n
+         else
+ 1          ipp=ip
+            ip=list(ip)
+            if ((ip.gt.0).and.(xn.gt.x(ip))) goto 1
+            list(ipp)=n
+         endif
+ 30      list(n)=ip
+      n=0
+      do 40 i=0,nl
+         ip=jptr(i)
+ 2       if (ip.eq.0) goto 40
+         n=n+1
+         ipp=ip
+         ip=list(ip)
+         list(ipp)=n
+         goto 2
+40       continue
+      end
+
+      subroutine indexx(nmax,x,list)
+c make index table using rank
+      dimension x(nmax), list(nmax)
+      
+      call rank(nmax,x,list)
+      call rank2index(nmax,list)
+      end
+
+      subroutine rank2index(nmax,list)
+c converts a list of ranks into an index table (or vice versa) in place
+      integer list(nmax)
+
+      do 10 n=1,nmax
+ 10      list(n)=-list(n)
+      do 20 n=1,nmax
+         if(list(n).gt.0) goto 20               ! has been put in place already
+         ib=n
+         im=-list(n)
+ 1       it=-list(im)
+         list(im)=ib
+         if(it.ne.n) then
+            ib=im
+            im=it
+            goto 1
+         else
+            list(n)=im
+         endif
+ 20      continue
+      end
+
+      subroutine sort(nmax,x,list)
+c sort using rank and rank2sort
+      dimension x(nmax), list(nmax)
+
+      call rank(nmax,x,list)
+      call rank2sort(nmax,x,list)
+      end
+
+      subroutine rank2sort(nmax,x,list)
+c sort x using list of ranks
+      dimension x(nmax), list(nmax)
+
+      do 10 n=1,nmax
+ 10      list(n)=-list(n)
+      do 20 n=1,nmax
+         if(list(n).gt.0) goto 20               ! has been put in place already
+         ib=n
+         hb=x(n)
+ 1       it=-list(ib)
+         list(ib)=it
+         ht=x(it)
+         x(it)=hb
+         if(it.ne.n) then
+            ib=it
+            hb=ht
+            goto 1
+         endif
+ 20      continue
+      end
+
+      subroutine index2sort(nmax,x,list)
+c sort x using list of indices
+      dimension x(nmax), list(nmax)
+
+      do 10 n=1,nmax
+ 10      list(n)=-list(n)
+      do 20 n=1,nmax
+         if(list(n).gt.0) goto 20               ! has been put in place already
+         ib=n
+         h=x(n)
+ 1       it=-list(ib)
+         list(ib)=it
+         if(it.ne.n) then
+            x(ib)=x(it)
+            ib=it
+            goto 1
+         else
+            x(ib)=h
+         endif
+ 20      continue
+      end
+
+      function which(nmax,x,k,list)
+      dimension x(nmax), list(nmax)
+
+      call indexx(nmax,x,list)
+      which=x(list(k))
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/readfile.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/readfile.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,186 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c
+c   i/o utilities for TISEAN f-sources
+c   author T. Schreiber (1998) based on earlier versions
+c===========================================================================
+      subroutine readfile(nmax,x,nexcl,icol,file,iverb)
+c read at most nmax points, return nmax
+      dimension x(nmax)
+      character*(*) file
+
+      iv=iv_io(iverb)
+      if(icol.eq.0) icol=igetcol(file)
+      if(icol.gt.0.and.iv.ne.0) 
+     .   write(istderr(),*) 'reading from column', icol
+      call infile(file,iunit,iverb)
+      lc=0
+      do 10 n=1,nexcl
+         lc=lc+1
+ 10      read(iunit,*,end=999)
+      do 20 n=1,nmax
+ 1       lc=lc+1
+         read(iunit,*,err=2,end=999) (dum,i=1,icol-1), x(n)
+         goto 20
+ 2       if(iv.ne.0) write(istderr(),*) "data in line ", lc, " ignored"
+         goto 1
+ 20      continue
+      if(iv.ne.0) write(istderr(),*) '*** readfile: warning:'//
+     .   ' maybe not the whole file has been used'
+ 999  nmax=n-1
+      if(iunit.ne.istdin()) close(iunit)
+      if(iv.ne.0) call readreport(nmax,file)
+      if(icol.gt.0.and.file.ne."-") call putcol(file,icol)
+      end
+
+      function igetcol(file)
+      character*(*) file
+
+      igetcol=0
+      do 10 i=len(file),1,-1
+ 10      if(file(i:i).eq.",") goto 1
+ 1    if(i.eq.0) return
+      read(file(i+1:len(file)),'(i10)',err=999) igetcol
+      file(i:len(file))=" "
+ 999  continue
+      end
+
+      subroutine putcol(file,icol)
+      character*(*) file
+
+      if(icol.le.9) then
+         write(file(index(file," "):index(file," ")+1),'(1h,,i1)') icol
+      else 
+         write(file(index(file," "):index(file," ")+2),'(1h,,i2)') icol
+      endif
+      end
+
+      subroutine writecfile(nmax,x,file,iverb,comm)
+c write comment and nmax points
+      dimension x(nmax)
+      character*(*) file,comm
+
+      call outfile(file,iunit,iverb)
+      if(comm.ne." ") write(iunit,'(a)') comm
+      do 10 n=1,nmax
+ 10      write(iunit,*) x(n)
+      if(iunit.eq.istdout()) then
+         write(iunit,*)
+         write(iunit,*)
+      else
+         close(iunit)
+      endif
+      if(iv_io(iverb).eq.1) call writereport(nmax,file)
+      end
+
+      subroutine writefile(nmax,x,file,iverb)
+c write nmax points
+      dimension x(nmax)
+      character*(*) file
+
+      call writecfile(nmax,x,file,iverb," ")
+      end
+
+      subroutine infile(file,iunit,iverb)
+c open file for read on iunit=ifile(), or iunit=istdin() if "-"      
+      character*(*) file
+
+      if(file.eq."-") then
+         iunit=istdin()
+         if(iv_io(iverb).eq.1) write(istderr(),*) "reading from stdin"
+         return
+      endif
+      iunit=ifilein()
+      open(iunit,file=file,status="old",err=999)
+      if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)') 
+     .   "opened ",file(1:index(file," ")-1), " for input"
+      return
+ 999  write(istderr(),'(a,a)') "Cannot open input file ",
+     .   file(1:index(file," ")-1)
+      stop
+      end
+
+      subroutine outfile(file,iunit,iverb)
+c open file for write on iunit=ifileout(), or iunit=istdout() if file=" "      
+      character*(*) file
+
+      if(file.eq." ") then
+         iunit=istdout()
+         if(iv_io(iverb).eq.1) write(istderr(),*) "writing to stdout"
+         return
+      endif
+      iunit=ifileout()
+      open(iunit,file=file,status='unknown',err=999)
+      if(iv_io(iverb).eq.1) write(istderr(),'(a,a,a)') 
+     .   "opened ",file(1:index(file," ")-1), " for output"
+      return
+ 999  write(istderr(),'(a,a)') "Cannot open output file ",
+     .   file(1:index(file," ")-1)
+      stop
+      end
+
+      subroutine suffix(base,suff)
+c append stuff after last nonblank character in base
+      character*(*) base, suff
+
+      base=base(1:index(base," ")-1)//suff
+      end
+
+      subroutine addsuff(target,base,suff)
+c append stuff after last nonblank character in base
+      character*(*) target,base, suff
+
+      target=base(1:index(base," ")-1)//suff
+      end
+
+      subroutine readreport(nmax,file)
+c report on numbers read
+      character*(*) file
+
+      if(file.eq."-") then
+         write(istderr(),'(i10,a)') nmax, ' values read from stdin'
+      else
+         write(istderr(),'(i10,a,a)') nmax, ' values read from file: ', 
+     .      file(1:index(file," ")-1)
+      endif
+      if(nmax.ne.0) return
+      if(file.eq."-") then
+         write(istderr(),'(a)') "No input given - aborting."
+      else
+         write(istderr(),'(a,a,a)') "Input file ",
+     .      file(1:index(file," ")-1), " empty - aborting."
+      endif
+      call usage()
+      end
+
+      subroutine writereport(nmax,file)
+c report on numbers written
+      character*(*) file
+
+      if(file.eq." ") then
+         write(istderr(),'(i10,a)') nmax, ' values written to stdout'
+      else
+         write(istderr(),'(i10,a,a)') nmax, ' values written to file: ', 
+     .      file(1:index(file," ")-1)
+      endif
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/rms.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/rms.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,82 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   subtract mean, normalise to unit variance, or
+c   print mean, standard deviation, and range of series in file(s)
+c   author T. Schreiber (1998) based on earlier versions
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file, fout
+      data lmean/0/, lvar/0/
+      data iverb/1/
+
+      call whatido("compute mean/standard deviation, normalise",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      if(lopt("a",1).eq.1) lmean=1
+      if(lopt("v",1).eq.1) lvar=1
+      isout=igetout(fout,iverb)
+      if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .   "mean / standard deviation / smallest / largest"
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         call rms(nmax,x,sc,sd)
+         call minmax(nmax,x,xmin,xmax)
+         if(lvar.eq.1.or.lmean.eq.1) then
+            if(iv_io(iverb).eq.1) write(istderr(),*) 
+     .         sc, sd, xmin, xmax, "   ", file(1:index(file," ")-1)
+            if(lvar.eq.1) then
+               if(isout.eq.1) call addsuff(fout,file,"_v")
+               call normal1(nmax,x,sc,sd)
+            else 
+               if(isout.eq.1) call addsuff(fout,file,"_a")
+               call normal(nmax,x,sc,sd)
+            endif
+            call writefile(nmax,x,fout,iverb)
+         else
+            write(*,*) 
+     .         sc, sd, xmin, xmax, "   ", file(1:index(file," ")-1)
+         endif
+ 10      continue
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-a -v -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("a","subtract average")
+      call popt("v","subtract mean, normalise to unit variance")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_a (if -a), file_v (if -v)")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/Makefile.in
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/Makefile.in	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,27 @@
+SHELL = /bin/sh
+
+FC = @FC@
+FFLAGS = @FFLAGS@
+LDFLAGS = @LDFLAGS@
+AR = @AR@
+ARFLAGS = @ARFLAGS@
+RANLIB = @RANLIB@
+
+# list of objects to be put in libslac.a 
+   INC  = d1mach.o r1mach.o i1mach.o \
+          rand.o rgauss.o dqk15.o  \
+          rs.o tql2.o tqlrat.o tred1.o tred2.o pythag.o \
+          rffti1.o rfftf1.o rfftb1.o \
+          radf2.o radf3.o radf4.o radf5.o radfg.o \
+          radb2.o radb3.o radb4.o radb5.o radbg.o \
+	  snls1.o fdjac3.o lmpar.o rwupdt.o chkder.o \
+          qrfac.o qrsolv.o enorm.o \
+          xercnt.o xermsg.o xerhlt.o xersve.o \
+          j4save.o xgetua.o xerprn.o fdump.o
+
+../libsla.a: $(INC)
+	$(AR) $(ARFLAGS) ../libsla.a $?
+	$(RANLIB) ../libsla.a
+
+clean: 
+	-@rm -f *.o *~ #*#
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/chkder.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/chkder.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,158 @@
+*DECK CHKDER
+      SUBROUTINE CHKDER (M, N, X, FVEC, FJAC, LDFJAC, XP, FVECP, MODE,
+     +   ERR)
+C***BEGIN PROLOGUE  CHKDER
+C***PURPOSE  Check the gradients of M nonlinear functions in N
+C            variables, evaluated at a point X, for consistency
+C            with the functions themselves.
+C***LIBRARY   SLATEC
+C***CATEGORY  F3, G4C
+C***TYPE      SINGLE PRECISION (CHKDER-S, DCKDER-D)
+C***KEYWORDS  GRADIENTS, JACOBIAN, MINPACK, NONLINEAR
+C***AUTHOR  Hiebert, K. L. (SNLA)
+C***DESCRIPTION
+C
+C   This subroutine is a companion routine to SNLS1,SNLS1E,SNSQ,and
+C   SNSQE which may be used to check the calculation of the Jacobian.
+C
+C     SUBROUTINE CHKDER
+C
+C     This subroutine checks the gradients of M nonlinear functions
+C     in N variables, evaluated at a point X, for consistency with
+C     the functions themselves. The user must call CKDER twice,
+C     first with MODE = 1 and then with MODE = 2.
+C
+C     MODE = 1. On input, X must contain the point of evaluation.
+C               On output, XP is set to a neighboring point.
+C
+C     MODE = 2. On input, FVEC must contain the functions and the
+C                         rows of FJAC must contain the gradients
+C                         of the respective functions each evaluated
+C                         at X, and FVECP must contain the functions
+C                         evaluated at XP.
+C               On output, ERR contains measures of correctness of
+C                          the respective gradients.
+C
+C     The subroutine does not perform reliably if cancellation or
+C     rounding errors cause a severe loss of significance in the
+C     evaluation of a function. Therefore, none of the components
+C     of X should be unusually small (in particular, zero) or any
+C     other value which may cause loss of significance.
+C
+C     The SUBROUTINE statement is
+C
+C       SUBROUTINE CHKDER(M,N,X,FVEC,FJAC,LDFJAC,XP,FVECP,MODE,ERR)
+C
+C     where
+C
+C       M is a positive integer input variable set to the number
+C         of functions.
+C
+C       N is a positive integer input variable set to the number
+C         of variables.
+C
+C       X is an input array of length N.
+C
+C       FVEC is an array of length M. On input when MODE = 2,
+C         FVEC must contain the functions evaluated at X.
+C
+C       FJAC is an M by N array. On input when MODE = 2,
+C         the rows of FJAC must contain the gradients of
+C         the respective functions evaluated at X.
+C
+C       LDFJAC is a positive integer input parameter not less than M
+C         which specifies the leading dimension of the array FJAC.
+C
+C       XP is an array of length N. On output when MODE = 1,
+C         XP is set to a neighboring point of X.
+C
+C       FVECP is an array of length M. On input when MODE = 2,
+C         FVECP must contain the functions evaluated at XP.
+C
+C       MODE is an integer input variable set to 1 on the first call
+C         and 2 on the second. Other values of MODE are equivalent
+C         to MODE = 1.
+C
+C       ERR is an array of length M. On output when MODE = 2,
+C         ERR contains measures of correctness of the respective
+C         gradients. If there is no severe loss of significance,
+C         then if ERR(I) is 1.0 the I-th gradient is correct,
+C         while if ERR(I) is 0.0 the I-th gradient is incorrect.
+C         For values of ERR between 0.0 and 1.0, the categorization
+C         is less certain. In general, a value of ERR(I) greater
+C         than 0.5 indicates that the I-th gradient is probably
+C         correct, while a value of ERR(I) less than 0.5 indicates
+C         that the I-th gradient is probably incorrect.
+C
+C***REFERENCES  M. J. D. Powell, A hybrid method for nonlinear equa-
+C                 tions. In Numerical Methods for Nonlinear Algebraic
+C                 Equations, P. Rabinowitz, Editor.  Gordon and Breach,
+C                 1988.
+C***ROUTINES CALLED  R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  CHKDER
+      INTEGER M,N,LDFJAC,MODE
+      REAL X(*),FVEC(*),FJAC(LDFJAC,*),XP(*),FVECP(*),ERR(*)
+      INTEGER I,J
+      REAL EPS,EPSF,EPSLOG,EPSMCH,FACTOR,ONE,TEMP,ZERO
+      REAL R1MACH
+      SAVE FACTOR, ONE, ZERO
+C
+      DATA FACTOR,ONE,ZERO /1.0E2,1.0E0,0.0E0/
+C***FIRST EXECUTABLE STATEMENT  CHKDER
+      EPSMCH = R1MACH(4)
+C
+      EPS = SQRT(EPSMCH)
+C
+      IF (MODE .EQ. 2) GO TO 20
+C
+C        MODE = 1.
+C
+         DO 10 J = 1, N
+            TEMP = EPS*ABS(X(J))
+            IF (TEMP .EQ. ZERO) TEMP = EPS
+            XP(J) = X(J) + TEMP
+   10       CONTINUE
+         GO TO 70
+   20 CONTINUE
+C
+C        MODE = 2.
+C
+         EPSF = FACTOR*EPSMCH
+         EPSLOG = LOG10(EPS)
+         DO 30 I = 1, M
+            ERR(I) = ZERO
+   30       CONTINUE
+         DO 50 J = 1, N
+            TEMP = ABS(X(J))
+            IF (TEMP .EQ. ZERO) TEMP = ONE
+            DO 40 I = 1, M
+               ERR(I) = ERR(I) + TEMP*FJAC(I,J)
+   40          CONTINUE
+   50       CONTINUE
+         DO 60 I = 1, M
+            TEMP = ONE
+            IF (FVEC(I) .NE. ZERO .AND. FVECP(I) .NE. ZERO
+     1          .AND. ABS(FVECP(I)-FVEC(I)) .GE. EPSF*ABS(FVEC(I)))
+     2         TEMP = EPS*ABS((FVECP(I)-FVEC(I))/EPS-ERR(I))
+     3                /(ABS(FVEC(I)) + ABS(FVECP(I)))
+            ERR(I) = ONE
+            IF (TEMP .GT. EPSMCH .AND. TEMP .LT. EPS)
+     1         ERR(I) = (LOG10(TEMP) - EPSLOG)/EPSLOG
+            IF (TEMP .GE. EPS) ERR(I) = ZERO
+   60       CONTINUE
+   70 CONTINUE
+C
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE CHKDER.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/d1mach.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/d1mach.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,19 @@
+      DOUBLE PRECISION FUNCTION D1MACH (I)
+c this is not the original one from slatec 
+      double precision const(5)
+c small:
+      DATA const(1) / 2.23D-308  /
+c large:
+      DATA const(2) / 1.79D+308  /
+c diff:
+      DATA const(3) / 1.11D-16   /
+      DATA const(4) / 2.22D-16   /
+c log10:
+      DATA const(5) / 0.301029995663981195D0 / 
+
+C***FIRST EXECUTABLE STATEMENT  D1MACH
+C
+      D1MACH = const(I)
+      RETURN
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/dqk15.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/dqk15.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,185 @@
+*DECK DQK15
+      SUBROUTINE DQK15 (F, A, B, RESULT, ABSERR, RESABS, RESASC)
+C***BEGIN PROLOGUE  DQK15
+C***PURPOSE  To compute I = Integral of F over (A,B), with error
+C                           estimate
+C                       J = integral of ABS(F) over (A,B)
+C***LIBRARY   SLATEC (QUADPACK)
+C***CATEGORY  H2A1A2
+C***TYPE      DOUBLE PRECISION (QK15-S, DQK15-D)
+C***KEYWORDS  15-POINT GAUSS-KRONROD RULES, QUADPACK, QUADRATURE
+C***AUTHOR  Piessens, Robert
+C             Applied Mathematics and Programming Division
+C             K. U. Leuven
+C           de Doncker, Elise
+C             Applied Mathematics and Programming Division
+C             K. U. Leuven
+C***DESCRIPTION
+C
+C           Integration rules
+C           Standard fortran subroutine
+C           Double precision version
+C
+C           PARAMETERS
+C            ON ENTRY
+C              F      - Double precision
+C                       Function subprogram defining the integrand
+C                       FUNCTION F(X). The actual name for F needs to be
+C                       Declared E X T E R N A L in the calling program.
+C
+C              A      - Double precision
+C                       Lower limit of integration
+C
+C              B      - Double precision
+C                       Upper limit of integration
+C
+C            ON RETURN
+C              RESULT - Double precision
+C                       Approximation to the integral I
+C                       Result is computed by applying the 15-POINT
+C                       KRONROD RULE (RESK) obtained by optimal addition
+C                       of abscissae to the 7-POINT GAUSS RULE(RESG).
+C
+C              ABSERR - Double precision
+C                       Estimate of the modulus of the absolute error,
+C                       which should not exceed ABS(I-RESULT)
+C
+C              RESABS - Double precision
+C                       Approximation to the integral J
+C
+C              RESASC - Double precision
+C                       Approximation to the integral of ABS(F-I/(B-A))
+C                       over (A,B)
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  D1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   800101  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890531  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C***END PROLOGUE  DQK15
+C
+      DOUBLE PRECISION A,ABSC,ABSERR,B,CENTR,DHLGTH,
+     1  D1MACH,EPMACH,F,FC,FSUM,FVAL1,FVAL2,FV1,FV2,HLGTH,RESABS,RESASC,
+     2  RESG,RESK,RESKH,RESULT,UFLOW,WG,WGK,XGK
+      INTEGER J,JTW,JTWM1
+      EXTERNAL F
+C
+      DIMENSION FV1(7),FV2(7),WG(4),WGK(8),XGK(8)
+C
+C           THE ABSCISSAE AND WEIGHTS ARE GIVEN FOR THE INTERVAL (-1,1).
+C           BECAUSE OF SYMMETRY ONLY THE POSITIVE ABSCISSAE AND THEIR
+C           CORRESPONDING WEIGHTS ARE GIVEN.
+C
+C           XGK    - ABSCISSAE OF THE 15-POINT KRONROD RULE
+C                    XGK(2), XGK(4), ...  ABSCISSAE OF THE 7-POINT
+C                    GAUSS RULE
+C                    XGK(1), XGK(3), ...  ABSCISSAE WHICH ARE OPTIMALLY
+C                    ADDED TO THE 7-POINT GAUSS RULE
+C
+C           WGK    - WEIGHTS OF THE 15-POINT KRONROD RULE
+C
+C           WG     - WEIGHTS OF THE 7-POINT GAUSS RULE
+C
+C
+C GAUSS QUADRATURE WEIGHTS AND KRONROD QUADRATURE ABSCISSAE AND WEIGHTS
+C AS EVALUATED WITH 80 DECIMAL DIGIT ARITHMETIC BY L. W. FULLERTON,
+C BELL LABS, NOV. 1981.
+C
+      SAVE WG, XGK, WGK
+      DATA WG  (  1) / 0.1294849661 6886969327 0611432679 082 D0 /
+      DATA WG  (  2) / 0.2797053914 8927666790 1467771423 780 D0 /
+      DATA WG  (  3) / 0.3818300505 0511894495 0369775488 975 D0 /
+      DATA WG  (  4) / 0.4179591836 7346938775 5102040816 327 D0 /
+C
+      DATA XGK (  1) / 0.9914553711 2081263920 6854697526 329 D0 /
+      DATA XGK (  2) / 0.9491079123 4275852452 6189684047 851 D0 /
+      DATA XGK (  3) / 0.8648644233 5976907278 9712788640 926 D0 /
+      DATA XGK (  4) / 0.7415311855 9939443986 3864773280 788 D0 /
+      DATA XGK (  5) / 0.5860872354 6769113029 4144838258 730 D0 /
+      DATA XGK (  6) / 0.4058451513 7739716690 6606412076 961 D0 /
+      DATA XGK (  7) / 0.2077849550 0789846760 0689403773 245 D0 /
+      DATA XGK (  8) / 0.0000000000 0000000000 0000000000 000 D0 /
+C
+      DATA WGK (  1) / 0.0229353220 1052922496 3732008058 970 D0 /
+      DATA WGK (  2) / 0.0630920926 2997855329 0700663189 204 D0 /
+      DATA WGK (  3) / 0.1047900103 2225018383 9876322541 518 D0 /
+      DATA WGK (  4) / 0.1406532597 1552591874 5189590510 238 D0 /
+      DATA WGK (  5) / 0.1690047266 3926790282 6583426598 550 D0 /
+      DATA WGK (  6) / 0.1903505780 6478540991 3256402421 014 D0 /
+      DATA WGK (  7) / 0.2044329400 7529889241 4161999234 649 D0 /
+      DATA WGK (  8) / 0.2094821410 8472782801 2999174891 714 D0 /
+C
+C
+C           LIST OF MAJOR VARIABLES
+C           -----------------------
+C
+C           CENTR  - MID POINT OF THE INTERVAL
+C           HLGTH  - HALF-LENGTH OF THE INTERVAL
+C           ABSC   - ABSCISSA
+C           FVAL*  - FUNCTION VALUE
+C           RESG   - RESULT OF THE 7-POINT GAUSS FORMULA
+C           RESK   - RESULT OF THE 15-POINT KRONROD FORMULA
+C           RESKH  - APPROXIMATION TO THE MEAN VALUE OF F OVER (A,B),
+C                    I.E. TO I/(B-A)
+C
+C           MACHINE DEPENDENT CONSTANTS
+C           ---------------------------
+C
+C           EPMACH IS THE LARGEST RELATIVE SPACING.
+C           UFLOW IS THE SMALLEST POSITIVE MAGNITUDE.
+C
+C***FIRST EXECUTABLE STATEMENT  DQK15
+      EPMACH = D1MACH(4)
+      UFLOW = D1MACH(1)
+C
+      CENTR = 0.5D+00*(A+B)
+      HLGTH = 0.5D+00*(B-A)
+      DHLGTH = ABS(HLGTH)
+C
+C           COMPUTE THE 15-POINT KRONROD APPROXIMATION TO
+C           THE INTEGRAL, AND ESTIMATE THE ABSOLUTE ERROR.
+C
+      FC = F(CENTR)
+      RESG = FC*WG(4)
+      RESK = FC*WGK(8)
+      RESABS = ABS(RESK)
+      DO 10 J=1,3
+        JTW = J*2
+        ABSC = HLGTH*XGK(JTW)
+        FVAL1 = F(CENTR-ABSC)
+        FVAL2 = F(CENTR+ABSC)
+        FV1(JTW) = FVAL1
+        FV2(JTW) = FVAL2
+        FSUM = FVAL1+FVAL2
+        RESG = RESG+WG(J)*FSUM
+        RESK = RESK+WGK(JTW)*FSUM
+        RESABS = RESABS+WGK(JTW)*(ABS(FVAL1)+ABS(FVAL2))
+   10 CONTINUE
+      DO 15 J = 1,4
+        JTWM1 = J*2-1
+        ABSC = HLGTH*XGK(JTWM1)
+        FVAL1 = F(CENTR-ABSC)
+        FVAL2 = F(CENTR+ABSC)
+        FV1(JTWM1) = FVAL1
+        FV2(JTWM1) = FVAL2
+        FSUM = FVAL1+FVAL2
+        RESK = RESK+WGK(JTWM1)*FSUM
+        RESABS = RESABS+WGK(JTWM1)*(ABS(FVAL1)+ABS(FVAL2))
+   15 CONTINUE
+      RESKH = RESK*0.5D+00
+      RESASC = WGK(8)*ABS(FC-RESKH)
+      DO 20 J=1,7
+        RESASC = RESASC+WGK(J)*(ABS(FV1(J)-RESKH)+ABS(FV2(J)-RESKH))
+   20 CONTINUE
+      RESULT = RESK*HLGTH
+      RESABS = RESABS*DHLGTH
+      RESASC = RESASC*DHLGTH
+      ABSERR = ABS((RESK-RESG)*HLGTH)
+      IF(RESASC.NE.0.0D+00.AND.ABSERR.NE.0.0D+00)
+     1  ABSERR = RESASC*MIN(0.1D+01,(0.2D+03*ABSERR/RESASC)**1.5D+00)
+      IF(RESABS.GT.UFLOW/(0.5D+02*EPMACH)) ABSERR = MAX
+     1  ((EPMACH*0.5D+02)*RESABS,ABSERR)
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/enorm.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/enorm.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,117 @@
+*DECK ENORM
+      REAL FUNCTION ENORM (N, X)
+C***BEGIN PROLOGUE  ENORM
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1, SNLS1E, SNSQ and SNSQE
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (ENORM-S, DENORM-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     Given an N-vector X, this function calculates the
+C     Euclidean norm of X.
+C
+C     The Euclidean norm is computed by accumulating the sum of
+C     squares in three different sums. The sums of squares for the
+C     small and large components are scaled so that no overflows
+C     occur. Non-destructive underflows are permitted. Underflows
+C     and overflows do not occur in the computation of the unscaled
+C     sum of squares for the intermediate components.
+C     The definitions of small, intermediate and large components
+C     depend on two constants, RDWARF and RGIANT. The main
+C     restrictions on these constants are that RDWARF**2 not
+C     underflow and RGIANT**2 not overflow. The constants
+C     given here are suitable for every known computer.
+C
+C     The function statement is
+C
+C       REAL FUNCTION ENORM(N,X)
+C
+C     where
+C
+C       N is a positive integer input variable.
+C
+C       X is an input array of length N.
+C
+C***SEE ALSO  SNLS1, SNLS1E, SNSQ, SNSQE
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  ENORM
+      INTEGER N
+      REAL X(*)
+      INTEGER I
+      REAL AGIANT,FLOATN,ONE,RDWARF,RGIANT,S1,S2,S3,XABS,X1MAX,X3MAX,
+     1     ZERO
+      SAVE ONE, ZERO, RDWARF, RGIANT
+      DATA ONE,ZERO,RDWARF,RGIANT /1.0E0,0.0E0,3.834E-20,1.304E19/
+C***FIRST EXECUTABLE STATEMENT  ENORM
+      S1 = ZERO
+      S2 = ZERO
+      S3 = ZERO
+      X1MAX = ZERO
+      X3MAX = ZERO
+      FLOATN = N
+      AGIANT = RGIANT/FLOATN
+      DO 90 I = 1, N
+         XABS = ABS(X(I))
+         IF (XABS .GT. RDWARF .AND. XABS .LT. AGIANT) GO TO 70
+            IF (XABS .LE. RDWARF) GO TO 30
+C
+C              SUM FOR LARGE COMPONENTS.
+C
+               IF (XABS .LE. X1MAX) GO TO 10
+                  S1 = ONE + S1*(X1MAX/XABS)**2
+                  X1MAX = XABS
+                  GO TO 20
+   10          CONTINUE
+                  S1 = S1 + (XABS/X1MAX)**2
+   20          CONTINUE
+               GO TO 60
+   30       CONTINUE
+C
+C              SUM FOR SMALL COMPONENTS.
+C
+               IF (XABS .LE. X3MAX) GO TO 40
+                  S3 = ONE + S3*(X3MAX/XABS)**2
+                  X3MAX = XABS
+                  GO TO 50
+   40          CONTINUE
+                  IF (XABS .NE. ZERO) S3 = S3 + (XABS/X3MAX)**2
+   50          CONTINUE
+   60       CONTINUE
+            GO TO 80
+   70    CONTINUE
+C
+C           SUM FOR INTERMEDIATE COMPONENTS.
+C
+            S2 = S2 + XABS**2
+   80    CONTINUE
+   90    CONTINUE
+C
+C     CALCULATION OF NORM.
+C
+      IF (S1 .EQ. ZERO) GO TO 100
+         ENORM = X1MAX*SQRT(S1+(S2/X1MAX)/X1MAX)
+         GO TO 130
+  100 CONTINUE
+         IF (S2 .EQ. ZERO) GO TO 110
+            IF (S2 .GE. X3MAX)
+     1         ENORM = SQRT(S2*(ONE+(X3MAX/S2)*(X3MAX*S3)))
+            IF (S2 .LT. X3MAX)
+     1         ENORM = SQRT(X3MAX*((S2/X3MAX)+(X3MAX*S3)))
+            GO TO 120
+  110    CONTINUE
+            ENORM = X3MAX*SQRT(S3)
+  120    CONTINUE
+  130 CONTINUE
+      RETURN
+C
+C     LAST CARD OF FUNCTION ENORM.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/fdjac3.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/fdjac3.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,114 @@
+*DECK FDJAC3
+      SUBROUTINE FDJAC3 (FCN, M, N, X, FVEC, FJAC, LDFJAC, IFLAG,
+     +   EPSFCN, WA)
+C***BEGIN PROLOGUE  FDJAC3
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1 and SNLS1E
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (FDJAC3-S, DFDJC3-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     This subroutine computes a forward-difference approximation
+C     to the M by N Jacobian matrix associated with a specified
+C     problem of M functions in N variables.
+C
+C     The subroutine statement is
+C
+C       SUBROUTINE FDJAC3(FCN,M,N,X,FVEC,FJAC,LDFJAC,IFLAG,EPSFCN,WA)
+C
+C     where
+C
+C       FCN is the name of the user-supplied subroutine which
+C         calculates the functions. FCN must be declared
+C         in an external statement in the user calling
+C         program, and should be written as follows.
+C
+C         SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
+C         INTEGER LDFJAC,M,N,IFLAG
+C         REAL X(N),FVEC(M),FJAC(LDFJAC,N)
+C         ----------
+C         When IFLAG.EQ.1 calculate the functions at X and
+C         return this vector in FVEC.
+C         ----------
+C         RETURN
+C         END
+C
+C         The value of IFLAG should not be changed by FCN unless
+C         the user wants to terminate execution of FDJAC3.
+C         In this case set IFLAG to a negative integer.
+C
+C       M is a positive integer input variable set to the number
+C         of functions.
+C
+C       N is a positive integer input variable set to the number
+C         of variables. N must not exceed M.
+C
+C       X is an input array of length N.
+C
+C       FVEC is an input array of length M which must contain the
+C         functions evaluated at X.
+C
+C       FJAC is an output M by N array which contains the
+C         approximation to the Jacobian matrix evaluated at X.
+C
+C       LDFJAC is a positive integer input variable not less than M
+C         which specifies the leading dimension of the array FJAC.
+C
+C       IFLAG is an integer variable which can be used to terminate
+C         THE EXECUTION OF FDJAC3. See description of FCN.
+C
+C       EPSFCN is an input variable used in determining a suitable
+C         step length for the forward-difference approximation. This
+C         approximation assumes that the relative errors in the
+C         functions are of the order of EPSFCN. If EPSFCN is less
+C         than the machine precision, it is assumed that the relative
+C         errors in the functions are of the order of the machine
+C         precision.
+C
+C       WA is a work array of length M.
+C
+C***SEE ALSO  SNLS1, SNLS1E
+C***ROUTINES CALLED  R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  FDJAC3
+      INTEGER M,N,LDFJAC,IFLAG
+      REAL EPSFCN
+      REAL X(*),FVEC(*),FJAC(LDFJAC,*),WA(*)
+      INTEGER I,J
+      REAL EPS,EPSMCH,H,TEMP,ZERO
+      REAL R1MACH
+      SAVE ZERO
+      DATA ZERO /0.0E0/
+C***FIRST EXECUTABLE STATEMENT  FDJAC3
+      EPSMCH = R1MACH(4)
+C
+      EPS = SQRT(MAX(EPSFCN,EPSMCH))
+C      SET IFLAG=1 TO INDICATE THAT FUNCTION VALUES
+C           ARE TO BE RETURNED BY FCN.
+      IFLAG = 1
+      DO 20 J = 1, N
+         TEMP = X(J)
+         H = EPS*ABS(TEMP)
+         IF (H .EQ. ZERO) H = EPS
+         X(J) = TEMP + H
+         CALL FCN(IFLAG,M,N,X,WA,FJAC,LDFJAC)
+         IF (IFLAG .LT. 0) GO TO 30
+         X(J) = TEMP
+         DO 10 I = 1, M
+            FJAC(I,J) = (WA(I) - FVEC(I))/H
+   10       CONTINUE
+   20    CONTINUE
+   30 CONTINUE
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE FDJAC3.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/fdump.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/fdump.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,31 @@
+*DECK FDUMP
+      SUBROUTINE FDUMP
+C***BEGIN PROLOGUE  FDUMP
+C***PURPOSE  Symbolic dump (should be locally written).
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3
+C***TYPE      ALL (FDUMP-A)
+C***KEYWORDS  ERROR, XERMSG
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C        ***Note*** Machine Dependent Routine
+C        FDUMP is intended to be replaced by a locally written
+C        version which produces a symbolic dump.  Failing this,
+C        it should be replaced by a version which prints the
+C        subprogram nesting list.  Note that this dump must be
+C        printed on each of up to five files, as indicated by the
+C        XGETUA routine.  See XSETUA and XGETUA for details.
+C
+C     Written by Ron Jones, with SLATEC Common Math Library Subcommittee
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C***END PROLOGUE  FDUMP
+C***FIRST EXECUTABLE STATEMENT  FDUMP
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/i1mach.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/i1mach.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,142 @@
+*DECK I1MACH
+      INTEGER FUNCTION I1MACH (I)
+c----------------------------------------------------------------------
+c
+c this is not quit the original one from slatec 
+c unit numbers for input/output/error are provided by calls to routines
+c from istdio.f change them there if needed!!!
+c
+c the other constants are not currently used by TISEAN and not checked
+c for any particular platform
+c
+c----------------------------------------------------------------------
+C***BEGIN PROLOGUE  I1MACH
+C***PURPOSE  Return integer machine dependent constants.
+C***LIBRARY   SLATEC
+C***CATEGORY  R1
+C***TYPE      INTEGER (I1MACH-I)
+C***KEYWORDS  MACHINE CONSTANTS
+C***AUTHOR  Fox, P. A., (Bell Labs)
+C           Hall, A. D., (Bell Labs)
+C           Schryer, N. L., (Bell Labs)
+C***DESCRIPTION
+C
+C   I1MACH can be used to obtain machine-dependent parameters for the
+C   local machine environment.  It is a function subprogram with one
+C   (input) argument and can be referenced as follows:
+C
+C        K = I1MACH(I)
+C
+C   where I=1,...,16.  The (output) value of K above is determined by
+C   the (input) value of I.  The results for various values of I are
+C   discussed below.
+C
+C   I/O unit numbers:
+C     I1MACH( 1) = the standard input unit.
+C     I1MACH( 2) = the standard output unit.
+C     I1MACH( 3) = the standard punch unit.
+C     I1MACH( 4) = the standard error message unit.
+C
+C   Words:
+C     I1MACH( 5) = the number of bits per integer storage unit.
+C     I1MACH( 6) = the number of characters per integer storage unit.
+C
+C   Integers:
+C     assume integers are represented in the S-digit, base-A form
+C
+C                sign ( X(S-1)*A**(S-1) + ... + X(1)*A + X(0) )
+C
+C                where 0 .LE. X(I) .LT. A for I=0,...,S-1.
+C     I1MACH( 7) = A, the base.
+C     I1MACH( 8) = S, the number of base-A digits.
+C     I1MACH( 9) = A**S - 1, the largest magnitude.
+C
+C   Floating-Point Numbers:
+C     Assume floating-point numbers are represented in the T-digit,
+C     base-B form
+C                sign (B**E)*( (X(1)/B) + ... + (X(T)/B**T) )
+C
+C                where 0 .LE. X(I) .LT. B for I=1,...,T,
+C                0 .LT. X(1), and EMIN .LE. E .LE. EMAX.
+C     I1MACH(10) = B, the base.
+C
+C   Single-Precision:
+C     I1MACH(11) = T, the number of base-B digits.
+C     I1MACH(12) = EMIN, the smallest exponent E.
+C     I1MACH(13) = EMAX, the largest exponent E.
+C
+C   Double-Precision:
+C     I1MACH(14) = T, the number of base-B digits.
+C     I1MACH(15) = EMIN, the smallest exponent E.
+C     I1MACH(16) = EMAX, the largest exponent E.
+C
+C   To alter this function for a particular environment, the desired
+C   set of DATA statements should be activated by removing the C from
+C   column 1.  Also, the values of I1MACH(1) - I1MACH(4) should be
+C   checked for consistency with the local operating system.
+C
+C***REFERENCES  P. A. Fox, A. D. Hall and N. L. Schryer, Framework for
+C                 a portable library, ACM Transactions on Mathematical
+C                 Software 4, 2 (June 1978), pp. 177-188.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   750101  DATE WRITTEN
+C   891012  Added VAX G-floating constants.  (WRB)
+C   891012  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900618  Added DEC RISC constants.  (WRB)
+C   900723  Added IBM RS 6000 constants.  (WRB)
+C   901009  Correct I1MACH(7) for IBM Mainframes. Should be 2 not 16.
+C           (RWC)
+C   910710  Added HP 730 constants.  (SMR)
+C   911114  Added Convex IEEE constants.  (WRB)
+C   920121  Added SUN -r8 compiler option constants.  (WRB)
+C   920229  Added Touchstone Delta i860 constants.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C   920625  Added Convex -p8 and -pd8 compiler option constants.
+C           (BKS, WRB)
+C   930201  Added DEC Alpha and SGI constants.  (RWC and WRB)
+C   930618  Corrected I1MACH(5) for Convex -p8 and -pd8 compiler
+C           options.  (DWL, RWC and WRB).
+C***END PROLOGUE  I1MACH
+C
+      INTEGER IMACH(16),OUTPUT
+      SAVE IMACH
+      EQUIVALENCE (IMACH(4),OUTPUT)
+
+      DATA IMACH( 1) /          5 /
+      DATA IMACH( 2) /          6 /
+      DATA IMACH( 3) /          0 /
+      DATA IMACH( 4) /          0 /
+      DATA IMACH( 5) /         32 /
+      DATA IMACH( 6) /          4 /
+      DATA IMACH( 7) /          2 /
+      DATA IMACH( 8) /         31 /
+      DATA IMACH( 9) / 2147483647 /
+      DATA IMACH(10) /          2 /
+      DATA IMACH(11) /         24 /
+      DATA IMACH(12) /       -125 /
+      DATA IMACH(13) /        127 /
+      DATA IMACH(14) /         53 /
+      DATA IMACH(15) /      -1021 /
+      DATA IMACH(16) /       1023 /
+
+C***FIRST EXECUTABLE STATEMENT  I1MACH
+      IMACH(1)=ISTDIN()
+      IMACH(2)=ISTDOUT()
+      IMACH(3)=ISTDERR()
+      IMACH(4)=ISTDERR()
+
+      IF (I .LT. 1  .OR.  I .GT. 16) GO TO 10
+C
+      I1MACH = IMACH(I)
+      RETURN
+C
+   10 CONTINUE
+      WRITE (UNIT = OUTPUT, FMT = 9000)
+ 9000 FORMAT ('1ERROR    1 IN I1MACH - I OUT OF BOUNDS')
+C
+C     CALL FDUMP
+C
+      STOP
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/j4save.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/j4save.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,65 @@
+*DECK J4SAVE
+      FUNCTION J4SAVE (IWHICH, IVALUE, ISET)
+C***BEGIN PROLOGUE  J4SAVE
+C***SUBSIDIARY
+C***PURPOSE  Save or recall global variables needed by error
+C            handling routines.
+C***LIBRARY   SLATEC (XERROR)
+C***TYPE      INTEGER (J4SAVE-I)
+C***KEYWORDS  ERROR MESSAGES, ERROR NUMBER, RECALL, SAVE, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        J4SAVE saves and recalls several global variables needed
+C        by the library error handling routines.
+C
+C     Description of Parameters
+C      --Input--
+C        IWHICH - Index of item desired.
+C                = 1 Refers to current error number.
+C                = 2 Refers to current error control flag.
+C                = 3 Refers to current unit number to which error
+C                    messages are to be sent.  (0 means use standard.)
+C                = 4 Refers to the maximum number of times any
+C                     message is to be printed (as set by XERMAX).
+C                = 5 Refers to the total number of units to which
+C                     each error message is to be written.
+C                = 6 Refers to the 2nd unit for error messages
+C                = 7 Refers to the 3rd unit for error messages
+C                = 8 Refers to the 4th unit for error messages
+C                = 9 Refers to the 5th unit for error messages
+C        IVALUE - The value to be set for the IWHICH-th parameter,
+C                 if ISET is .TRUE. .
+C        ISET   - If ISET=.TRUE., the IWHICH-th parameter will BE
+C                 given the value, IVALUE.  If ISET=.FALSE., the
+C                 IWHICH-th parameter will be unchanged, and IVALUE
+C                 is a dummy parameter.
+C      --Output--
+C        The (old) value of the IWHICH-th parameter will be returned
+C        in the function value, J4SAVE.
+C
+C***SEE ALSO  XERMSG
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900205  Minor modifications to prologue.  (WRB)
+C   900402  Added TYPE section.  (WRB)
+C   910411  Added KEYWORDS section.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  J4SAVE
+      LOGICAL ISET
+      INTEGER IPARAM(9)
+      SAVE IPARAM
+      DATA IPARAM(1),IPARAM(2),IPARAM(3),IPARAM(4)/0,2,0,10/
+      DATA IPARAM(5)/1/
+      DATA IPARAM(6),IPARAM(7),IPARAM(8),IPARAM(9)/0,0,0,0/
+C***FIRST EXECUTABLE STATEMENT  J4SAVE
+      J4SAVE = IPARAM(IWHICH)
+      IF (ISET) IPARAM(IWHICH) = IVALUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/lmpar.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/lmpar.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,267 @@
+*DECK LMPAR
+      SUBROUTINE LMPAR (N, R, LDR, IPVT, DIAG, QTB, DELTA, PAR, X,
+     +   SIGMA, WA1, WA2)
+C***BEGIN PROLOGUE  LMPAR
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1 and SNLS1E
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (LMPAR-S, DMPAR-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     Given an M by N matrix A, an N by N nonsingular DIAGONAL
+C     matrix D, an M-vector B, and a positive number DELTA,
+C     the problem is to determine a value for the parameter
+C     PAR such that if X solves the system
+C
+C           A*X = B ,     SQRT(PAR)*D*X = 0 ,
+C
+C     in the least squares sense, and DXNORM is the Euclidean
+C     norm of D*X, then either PAR is zero and
+C
+C           (DXNORM-DELTA) .LE. 0.1*DELTA ,
+C
+C     or PAR is positive and
+C
+C           ABS(DXNORM-DELTA) .LE. 0.1*DELTA .
+C
+C     This subroutine completes the solution of the problem
+C     if it is provided with the necessary information from the
+C     QR factorization, with column pivoting, of A. That is, if
+C     A*P = Q*R, where P is a permutation matrix, Q has orthogonal
+C     columns, and R is an upper triangular matrix with diagonal
+C     elements of nonincreasing magnitude, then LMPAR expects
+C     the full upper triangle of R, the permutation matrix P,
+C     and the first N components of (Q TRANSPOSE)*B. On output
+C     LMPAR also provides an upper triangular matrix S such that
+C
+C            T   T                   T
+C           P *(A *A + PAR*D*D)*P = S *S .
+C
+C     S is employed within LMPAR and may be of separate interest.
+C
+C     Only a few iterations are generally needed for convergence
+C     of the algorithm. If, however, the limit of 10 iterations
+C     is reached, then the output PAR will contain the best
+C     value obtained so far.
+C
+C     The subroutine statement is
+C
+C       SUBROUTINE LMPAR(N,R,LDR,IPVT,DIAG,QTB,DELTA,PAR,X,SIGMA,
+C                        WA1,WA2)
+C
+C     where
+C
+C       N is a positive integer input variable set to the order of R.
+C
+C       R is an N by N array. On input the full upper triangle
+C         must contain the full upper triangle of the matrix R.
+C         On output the full upper triangle is unaltered, and the
+C         strict lower triangle contains the strict upper triangle
+C         (transposed) of the upper triangular matrix S.
+C
+C       LDR is a positive integer input variable not less than N
+C         which specifies the leading dimension of the array R.
+C
+C       IPVT is an integer input array of length N which defines the
+C         permutation matrix P such that A*P = Q*R. Column J of P
+C         is column IPVT(J) of the identity matrix.
+C
+C       DIAG is an input array of length N which must contain the
+C         diagonal elements of the matrix D.
+C
+C       QTB is an input array of length N which must contain the first
+C         N elements of the vector (Q TRANSPOSE)*B.
+C
+C       DELTA is a positive input variable which specifies an upper
+C         bound on the Euclidean norm of D*X.
+C
+C       PAR is a nonnegative variable. On input PAR contains an
+C         initial estimate of the Levenberg-Marquardt parameter.
+C         On output PAR contains the final estimate.
+C
+C       X is an output array of length N which contains the least
+C         squares solution of the system A*X = B, SQRT(PAR)*D*X = 0,
+C         for the output PAR.
+C
+C       SIGMA is an output array of length N which contains the
+C         diagonal elements of the upper triangular matrix S.
+C
+C       WA1 and WA2 are work arrays of length N.
+C
+C***SEE ALSO  SNLS1, SNLS1E
+C***ROUTINES CALLED  ENORM, QRSOLV, R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  LMPAR
+      INTEGER N,LDR
+      INTEGER IPVT(*)
+      REAL DELTA,PAR
+      REAL R(LDR,*),DIAG(*),QTB(*),X(*),SIGMA(*),WA1(*),WA2(*)
+      INTEGER I,ITER,J,JM1,JP1,K,L,NSING
+      REAL DXNORM,DWARF,FP,GNORM,PARC,PARL,PARU,P1,P001,SUM,TEMP,ZERO
+      REAL R1MACH,ENORM
+      SAVE P1, P001, ZERO
+      DATA P1,P001,ZERO /1.0E-1,1.0E-3,0.0E0/
+C***FIRST EXECUTABLE STATEMENT  LMPAR
+      DWARF = R1MACH(1)
+C
+C     COMPUTE AND STORE IN X THE GAUSS-NEWTON DIRECTION. IF THE
+C     JACOBIAN IS RANK-DEFICIENT, OBTAIN A LEAST SQUARES SOLUTION.
+C
+      NSING = N
+      DO 10 J = 1, N
+         WA1(J) = QTB(J)
+         IF (R(J,J) .EQ. ZERO .AND. NSING .EQ. N) NSING = J - 1
+         IF (NSING .LT. N) WA1(J) = ZERO
+   10    CONTINUE
+      IF (NSING .LT. 1) GO TO 50
+      DO 40 K = 1, NSING
+         J = NSING - K + 1
+         WA1(J) = WA1(J)/R(J,J)
+         TEMP = WA1(J)
+         JM1 = J - 1
+         IF (JM1 .LT. 1) GO TO 30
+         DO 20 I = 1, JM1
+            WA1(I) = WA1(I) - R(I,J)*TEMP
+   20       CONTINUE
+   30    CONTINUE
+   40    CONTINUE
+   50 CONTINUE
+      DO 60 J = 1, N
+         L = IPVT(J)
+         X(L) = WA1(J)
+   60    CONTINUE
+C
+C     INITIALIZE THE ITERATION COUNTER.
+C     EVALUATE THE FUNCTION AT THE ORIGIN, AND TEST
+C     FOR ACCEPTANCE OF THE GAUSS-NEWTON DIRECTION.
+C
+      ITER = 0
+      DO 70 J = 1, N
+         WA2(J) = DIAG(J)*X(J)
+   70    CONTINUE
+      DXNORM = ENORM(N,WA2)
+      FP = DXNORM - DELTA
+      IF (FP .LE. P1*DELTA) GO TO 220
+C
+C     IF THE JACOBIAN IS NOT RANK DEFICIENT, THE NEWTON
+C     STEP PROVIDES A LOWER BOUND, PARL, FOR THE ZERO OF
+C     THE FUNCTION. OTHERWISE SET THIS BOUND TO ZERO.
+C
+      PARL = ZERO
+      IF (NSING .LT. N) GO TO 120
+      DO 80 J = 1, N
+         L = IPVT(J)
+         WA1(J) = DIAG(L)*(WA2(L)/DXNORM)
+   80    CONTINUE
+      DO 110 J = 1, N
+         SUM = ZERO
+         JM1 = J - 1
+         IF (JM1 .LT. 1) GO TO 100
+         DO 90 I = 1, JM1
+            SUM = SUM + R(I,J)*WA1(I)
+   90       CONTINUE
+  100    CONTINUE
+         WA1(J) = (WA1(J) - SUM)/R(J,J)
+  110    CONTINUE
+      TEMP = ENORM(N,WA1)
+      PARL = ((FP/DELTA)/TEMP)/TEMP
+  120 CONTINUE
+C
+C     CALCULATE AN UPPER BOUND, PARU, FOR THE ZERO OF THE FUNCTION.
+C
+      DO 140 J = 1, N
+         SUM = ZERO
+         DO 130 I = 1, J
+            SUM = SUM + R(I,J)*QTB(I)
+  130       CONTINUE
+         L = IPVT(J)
+         WA1(J) = SUM/DIAG(L)
+  140    CONTINUE
+      GNORM = ENORM(N,WA1)
+      PARU = GNORM/DELTA
+      IF (PARU .EQ. ZERO) PARU = DWARF/MIN(DELTA,P1)
+C
+C     IF THE INPUT PAR LIES OUTSIDE OF THE INTERVAL (PARL,PARU),
+C     SET PAR TO THE CLOSER ENDPOINT.
+C
+      PAR = MAX(PAR,PARL)
+      PAR = MIN(PAR,PARU)
+      IF (PAR .EQ. ZERO) PAR = GNORM/DXNORM
+C
+C     BEGINNING OF AN ITERATION.
+C
+  150 CONTINUE
+         ITER = ITER + 1
+C
+C        EVALUATE THE FUNCTION AT THE CURRENT VALUE OF PAR.
+C
+         IF (PAR .EQ. ZERO) PAR = MAX(DWARF,P001*PARU)
+         TEMP = SQRT(PAR)
+         DO 160 J = 1, N
+            WA1(J) = TEMP*DIAG(J)
+  160       CONTINUE
+         CALL QRSOLV(N,R,LDR,IPVT,WA1,QTB,X,SIGMA,WA2)
+         DO 170 J = 1, N
+            WA2(J) = DIAG(J)*X(J)
+  170       CONTINUE
+         DXNORM = ENORM(N,WA2)
+         TEMP = FP
+         FP = DXNORM - DELTA
+C
+C        IF THE FUNCTION IS SMALL ENOUGH, ACCEPT THE CURRENT VALUE
+C        OF PAR. ALSO TEST FOR THE EXCEPTIONAL CASES WHERE PARL
+C        IS ZERO OR THE NUMBER OF ITERATIONS HAS REACHED 10.
+C
+         IF (ABS(FP) .LE. P1*DELTA
+     1       .OR. PARL .EQ. ZERO .AND. FP .LE. TEMP
+     2            .AND. TEMP .LT. ZERO .OR. ITER .EQ. 10) GO TO 220
+C
+C        COMPUTE THE NEWTON CORRECTION.
+C
+         DO 180 J = 1, N
+            L = IPVT(J)
+            WA1(J) = DIAG(L)*(WA2(L)/DXNORM)
+  180       CONTINUE
+         DO 210 J = 1, N
+            WA1(J) = WA1(J)/SIGMA(J)
+            TEMP = WA1(J)
+            JP1 = J + 1
+            IF (N .LT. JP1) GO TO 200
+            DO 190 I = JP1, N
+               WA1(I) = WA1(I) - R(I,J)*TEMP
+  190          CONTINUE
+  200       CONTINUE
+  210       CONTINUE
+         TEMP = ENORM(N,WA1)
+         PARC = ((FP/DELTA)/TEMP)/TEMP
+C
+C        DEPENDING ON THE SIGN OF THE FUNCTION, UPDATE PARL OR PARU.
+C
+         IF (FP .GT. ZERO) PARL = MAX(PARL,PAR)
+         IF (FP .LT. ZERO) PARU = MIN(PARU,PAR)
+C
+C        COMPUTE AN IMPROVED ESTIMATE FOR PAR.
+C
+         PAR = MAX(PARL,PAR+PARC)
+C
+C        END OF AN ITERATION.
+C
+         GO TO 150
+  220 CONTINUE
+C
+C     TERMINATION.
+C
+      IF (ITER .EQ. 0) PAR = ZERO
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE LMPAR.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/pythag.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/pythag.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,39 @@
+*DECK PYTHAG
+      REAL FUNCTION PYTHAG (A, B)
+C***BEGIN PROLOGUE  PYTHAG
+C***SUBSIDIARY
+C***PURPOSE  Compute the complex square root of a complex number without
+C            destructive overflow or underflow.
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (PYTHAG-S)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     Finds sqrt(A**2+B**2) without overflow or destructive underflow
+C
+C***SEE ALSO  EISDOC
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   811101  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  PYTHAG
+      REAL A,B
+C
+      REAL P,Q,R,S,T
+C***FIRST EXECUTABLE STATEMENT  PYTHAG
+      P = MAX(ABS(A),ABS(B))
+      Q = MIN(ABS(A),ABS(B))
+      IF (Q .EQ. 0.0E0) GO TO 20
+   10 CONTINUE
+         R = (Q/P)**2
+         T = 4.0E0 + R
+         IF (T .EQ. 4.0E0) GO TO 20
+         S = R/T
+         P = P + 2.0E0*P*S
+         Q = Q*S
+      GO TO 10
+   20 PYTHAG = P
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/qrfac.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/qrfac.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,170 @@
+*DECK QRFAC
+      SUBROUTINE QRFAC (M, N, A, LDA, PIVOT, IPVT, LIPVT, SIGMA, ACNORM,
+     +   WA)
+C***BEGIN PROLOGUE  QRFAC
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1, SNLS1E, SNSQ and SNSQE
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (QRFAC-S, DQRFAC-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     This subroutine uses Householder transformations with column
+C     pivoting (optional) to compute a QR factorization of the
+C     M by N matrix A. That is, QRFAC determines an orthogonal
+C     matrix Q, a permutation matrix P, and an upper trapezoidal
+C     matrix R with diagonal elements of nonincreasing magnitude,
+C     such that A*P = Q*R. The Householder transformation for
+C     column K, K = 1,2,...,MIN(M,N), is of the form
+C
+C                           T
+C           I - (1/U(K))*U*U
+C
+C     where U has zeros in the first K-1 positions. The form of
+C     this transformation and the method of pivoting first
+C     appeared in the corresponding LINPACK subroutine.
+C
+C     The subroutine statement is
+C
+C       SUBROUTINE QRFAC(M,N,A,LDA,PIVOT,IPVT,LIPVT,SIGMA,ACNORM,WA)
+C
+C     where
+C
+C       M is a positive integer input variable set to the number
+C         of rows of A.
+C
+C       N is a positive integer input variable set to the number
+C         of columns of A.
+C
+C       A is an M by N array. On input A contains the matrix for
+C         which the QR factorization is to be computed. On output
+C         the strict upper trapezoidal part of A contains the strict
+C         upper trapezoidal part of R, and the lower trapezoidal
+C         part of A contains a factored form of Q (the non-trivial
+C         elements of the U vectors described above).
+C
+C       LDA is a positive integer input variable not less than M
+C         which specifies the leading dimension of the array A.
+C
+C       PIVOT is a logical input variable. If pivot is set .TRUE.,
+C         then column pivoting is enforced. If pivot is set .FALSE.,
+C         then no column pivoting is done.
+C
+C       IPVT is an integer output array of length LIPVT. IPVT
+C         defines the permutation matrix P such that A*P = Q*R.
+C         Column J of P is column IPVT(J) of the identity matrix.
+C         If pivot is .FALSE., IPVT is not referenced.
+C
+C       LIPVT is a positive integer input variable. If PIVOT is
+C             .FALSE., then LIPVT may be as small as 1. If PIVOT is
+C             .TRUE., then LIPVT must be at least N.
+C
+C       SIGMA is an output array of length N which contains the
+C         diagonal elements of R.
+C
+C       ACNORM is an output array of length N which contains the
+C         norms of the corresponding columns of the input matrix A.
+C         If this information is not needed, then ACNORM can coincide
+C         with SIGMA.
+C
+C       WA is a work array of length N. If pivot is .FALSE., then WA
+C         can coincide with SIGMA.
+C
+C***SEE ALSO  SNLS1, SNLS1E, SNSQ, SNSQE
+C***ROUTINES CALLED  ENORM, R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  QRFAC
+      INTEGER M,N,LDA,LIPVT
+      INTEGER IPVT(*)
+      LOGICAL PIVOT
+      REAL A(LDA,*),SIGMA(*),ACNORM(*),WA(*)
+      INTEGER I,J,JP1,K,KMAX,MINMN
+      REAL AJNORM,EPSMCH,ONE,P05,SUM,TEMP,ZERO
+      REAL R1MACH,ENORM
+      SAVE ONE, P05, ZERO
+      DATA ONE,P05,ZERO /1.0E0,5.0E-2,0.0E0/
+C***FIRST EXECUTABLE STATEMENT  QRFAC
+      EPSMCH = R1MACH(4)
+C
+C     COMPUTE THE INITIAL COLUMN NORMS AND INITIALIZE SEVERAL ARRAYS.
+C
+      DO 10 J = 1, N
+         ACNORM(J) = ENORM(M,A(1,J))
+         SIGMA(J) = ACNORM(J)
+         WA(J) = SIGMA(J)
+         IF (PIVOT) IPVT(J) = J
+   10    CONTINUE
+C
+C     REDUCE A TO R WITH HOUSEHOLDER TRANSFORMATIONS.
+C
+      MINMN = MIN(M,N)
+      DO 110 J = 1, MINMN
+         IF (.NOT.PIVOT) GO TO 40
+C
+C        BRING THE COLUMN OF LARGEST NORM INTO THE PIVOT POSITION.
+C
+         KMAX = J
+         DO 20 K = J, N
+            IF (SIGMA(K) .GT. SIGMA(KMAX)) KMAX = K
+   20       CONTINUE
+         IF (KMAX .EQ. J) GO TO 40
+         DO 30 I = 1, M
+            TEMP = A(I,J)
+            A(I,J) = A(I,KMAX)
+            A(I,KMAX) = TEMP
+   30       CONTINUE
+         SIGMA(KMAX) = SIGMA(J)
+         WA(KMAX) = WA(J)
+         K = IPVT(J)
+         IPVT(J) = IPVT(KMAX)
+         IPVT(KMAX) = K
+   40    CONTINUE
+C
+C        COMPUTE THE HOUSEHOLDER TRANSFORMATION TO REDUCE THE
+C        J-TH COLUMN OF A TO A MULTIPLE OF THE J-TH UNIT VECTOR.
+C
+         AJNORM = ENORM(M-J+1,A(J,J))
+         IF (AJNORM .EQ. ZERO) GO TO 100
+         IF (A(J,J) .LT. ZERO) AJNORM = -AJNORM
+         DO 50 I = J, M
+            A(I,J) = A(I,J)/AJNORM
+   50       CONTINUE
+         A(J,J) = A(J,J) + ONE
+C
+C        APPLY THE TRANSFORMATION TO THE REMAINING COLUMNS
+C        AND UPDATE THE NORMS.
+C
+         JP1 = J + 1
+         IF (N .LT. JP1) GO TO 100
+         DO 90 K = JP1, N
+            SUM = ZERO
+            DO 60 I = J, M
+               SUM = SUM + A(I,J)*A(I,K)
+   60          CONTINUE
+            TEMP = SUM/A(J,J)
+            DO 70 I = J, M
+               A(I,K) = A(I,K) - TEMP*A(I,J)
+   70          CONTINUE
+            IF (.NOT.PIVOT .OR. SIGMA(K) .EQ. ZERO) GO TO 80
+            TEMP = A(J,K)/SIGMA(K)
+            SIGMA(K) = SIGMA(K)*SQRT(MAX(ZERO,ONE-TEMP**2))
+            IF (P05*(SIGMA(K)/WA(K))**2 .GT. EPSMCH) GO TO 80
+            SIGMA(K) = ENORM(M-J,A(JP1,K))
+            WA(K) = SIGMA(K)
+   80       CONTINUE
+   90       CONTINUE
+  100    CONTINUE
+         SIGMA(J) = -AJNORM
+  110    CONTINUE
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE QRFAC.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/qrsolv.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/qrsolv.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,198 @@
+*DECK QRSOLV
+      SUBROUTINE QRSOLV (N, R, LDR, IPVT, DIAG, QTB, X, SIGMA, WA)
+C***BEGIN PROLOGUE  QRSOLV
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1 and SNLS1E
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (QRSOLV-S, DQRSLV-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     Given an M by N matrix A, an N by N diagonal matrix D,
+C     and an M-vector B, the problem is to determine an X which
+C     solves the system
+C
+C           A*X = B ,     D*X = 0 ,
+C
+C     in the least squares sense.
+C
+C     This subroutine completes the solution of the problem
+C     if it is provided with the necessary information from the
+C     QR factorization, with column pivoting, of A. That is, if
+C     A*P = Q*R, where P is a permutation matrix, Q has orthogonal
+C     columns, and R is an upper triangular matrix with diagonal
+C     elements of nonincreasing magnitude, then QRSOLV expects
+C     the full upper triangle of R, the permutation matrix P,
+C     and the first N components of (Q TRANSPOSE)*B. The system
+C     A*X = B, D*X = 0, is then equivalent to
+C
+C                  T       T
+C           R*Z = Q *B ,  P *D*P*Z = 0 ,
+C
+C     where X = P*Z. If this system does not have full rank,
+C     then a least squares solution is obtained. On output QRSOLV
+C     also provides an upper triangular matrix S such that
+C
+C            T   T               T
+C           P *(A *A + D*D)*P = S *S .
+C
+C     S is computed within QRSOLV and may be of separate interest.
+C
+C     The subroutine statement is
+C
+C       SUBROUTINE QRSOLV(N,R,LDR,IPVT,DIAG,QTB,X,SIGMA,WA)
+C
+C     where
+C
+C       N is a positive integer input variable set to the order of R.
+C
+C       R is an N by N array. On input the full upper triangle
+C         must contain the full upper triangle of the matrix R.
+C         On output the full upper triangle is unaltered, and the
+C         strict lower triangle contains the strict upper triangle
+C         (transposed) of the upper triangular matrix S.
+C
+C       LDR is a positive integer input variable not less than N
+C         which specifies the leading dimension of the array R.
+C
+C       IPVT is an integer input array of length N which defines the
+C         permutation matrix P such that A*P = Q*R. Column J of P
+C         is column IPVT(J) of the identity matrix.
+C
+C       DIAG is an input array of length N which must contain the
+C         diagonal elements of the matrix D.
+C
+C       QTB is an input array of length N which must contain the first
+C         N elements of the vector (Q TRANSPOSE)*B.
+C
+C       X is an output array of length N which contains the least
+C         squares solution of the system A*X = B, D*X = 0.
+C
+C       SIGMA is an output array of length N which contains the
+C         diagonal elements of the upper triangular matrix S.
+C
+C       WA is a work array of length N.
+C
+C***SEE ALSO  SNLS1, SNLS1E
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  QRSOLV
+      INTEGER N,LDR
+      INTEGER IPVT(*)
+      REAL R(LDR,*),DIAG(*),QTB(*),X(*),SIGMA(*),WA(*)
+      INTEGER I,J,JP1,K,KP1,L,NSING
+      REAL COS,COTAN,P5,P25,QTBPJ,SIN,SUM,TAN,TEMP,ZERO
+      SAVE P5, P25, ZERO
+      DATA P5,P25,ZERO /5.0E-1,2.5E-1,0.0E0/
+C***FIRST EXECUTABLE STATEMENT  QRSOLV
+      DO 20 J = 1, N
+         DO 10 I = J, N
+            R(I,J) = R(J,I)
+   10       CONTINUE
+         X(J) = R(J,J)
+         WA(J) = QTB(J)
+   20    CONTINUE
+C
+C     ELIMINATE THE DIAGONAL MATRIX D USING A GIVENS ROTATION.
+C
+      DO 100 J = 1, N
+C
+C        PREPARE THE ROW OF D TO BE ELIMINATED, LOCATING THE
+C        DIAGONAL ELEMENT USING P FROM THE QR FACTORIZATION.
+C
+         L = IPVT(J)
+         IF (DIAG(L) .EQ. ZERO) GO TO 90
+         DO 30 K = J, N
+            SIGMA(K) = ZERO
+   30       CONTINUE
+         SIGMA(J) = DIAG(L)
+C
+C        THE TRANSFORMATIONS TO ELIMINATE THE ROW OF D
+C        MODIFY ONLY A SINGLE ELEMENT OF (Q TRANSPOSE)*B
+C        BEYOND THE FIRST N, WHICH IS INITIALLY ZERO.
+C
+         QTBPJ = ZERO
+         DO 80 K = J, N
+C
+C           DETERMINE A GIVENS ROTATION WHICH ELIMINATES THE
+C           APPROPRIATE ELEMENT IN THE CURRENT ROW OF D.
+C
+            IF (SIGMA(K) .EQ. ZERO) GO TO 70
+            IF (ABS(R(K,K)) .GE. ABS(SIGMA(K))) GO TO 40
+               COTAN = R(K,K)/SIGMA(K)
+               SIN = P5/SQRT(P25+P25*COTAN**2)
+               COS = SIN*COTAN
+               GO TO 50
+   40       CONTINUE
+               TAN = SIGMA(K)/R(K,K)
+               COS = P5/SQRT(P25+P25*TAN**2)
+               SIN = COS*TAN
+   50       CONTINUE
+C
+C           COMPUTE THE MODIFIED DIAGONAL ELEMENT OF R AND
+C           THE MODIFIED ELEMENT OF ((Q TRANSPOSE)*B,0).
+C
+            R(K,K) = COS*R(K,K) + SIN*SIGMA(K)
+            TEMP = COS*WA(K) + SIN*QTBPJ
+            QTBPJ = -SIN*WA(K) + COS*QTBPJ
+            WA(K) = TEMP
+C
+C           ACCUMULATE THE TRANSFORMATION IN THE ROW OF S.
+C
+            KP1 = K + 1
+            IF (N .LT. KP1) GO TO 70
+            DO 60 I = KP1, N
+               TEMP = COS*R(I,K) + SIN*SIGMA(I)
+               SIGMA(I) = -SIN*R(I,K) + COS*SIGMA(I)
+               R(I,K) = TEMP
+   60          CONTINUE
+   70       CONTINUE
+   80       CONTINUE
+   90    CONTINUE
+C
+C        STORE THE DIAGONAL ELEMENT OF S AND RESTORE
+C        THE CORRESPONDING DIAGONAL ELEMENT OF R.
+C
+         SIGMA(J) = R(J,J)
+         R(J,J) = X(J)
+  100    CONTINUE
+C
+C     SOLVE THE TRIANGULAR SYSTEM FOR Z. IF THE SYSTEM IS
+C     SINGULAR, THEN OBTAIN A LEAST SQUARES SOLUTION.
+C
+      NSING = N
+      DO 110 J = 1, N
+         IF (SIGMA(J) .EQ. ZERO .AND. NSING .EQ. N) NSING = J - 1
+         IF (NSING .LT. N) WA(J) = ZERO
+  110    CONTINUE
+      IF (NSING .LT. 1) GO TO 150
+      DO 140 K = 1, NSING
+         J = NSING - K + 1
+         SUM = ZERO
+         JP1 = J + 1
+         IF (NSING .LT. JP1) GO TO 130
+         DO 120 I = JP1, NSING
+            SUM = SUM + R(I,J)*WA(I)
+  120       CONTINUE
+  130    CONTINUE
+         WA(J) = (WA(J) - SUM)/SIGMA(J)
+  140    CONTINUE
+  150 CONTINUE
+C
+C     PERMUTE THE COMPONENTS OF Z BACK TO COMPONENTS OF X.
+C
+      DO 160 J = 1, N
+         L = IPVT(J)
+         X(L) = WA(J)
+  160    CONTINUE
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE QRSOLV.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/r1mach.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/r1mach.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,21 @@
+      FUNCTION r1MACH (I)
+c this is not the original one from slatec 
+      dimension const(5)
+c small:
+      DATA const(1) / 1.18E-38      /
+c large:
+      DATA const(2) / 3.40E+38      /
+c diff:
+      DATA const(3) / 0.595E-07     /
+      DATA const(4) / 1.19E-07      /
+c log10:
+      DATA const(5) / 0.30102999566 /
+
+C***FIRST EXECUTABLE STATEMENT  R1MACH
+C
+      R1MACH = const(I)
+      RETURN
+C
+      END
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radb2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radb2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,61 @@
+*DECK RADB2
+      SUBROUTINE RADB2 (IDO, L1, CC, CH, WA1)
+C***BEGIN PROLOGUE  RADB2
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length two.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADB2-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           changing dummy array size declarations (1) to (*).
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADB2
+      DIMENSION CC(IDO,2,*), CH(IDO,L1,2), WA1(*)
+C***FIRST EXECUTABLE STATEMENT  RADB2
+      DO 101 K=1,L1
+         CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
+         CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
+  101 CONTINUE
+      IF (IDO-2) 107,105,102
+  102 IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 108
+      DO 104 K=1,L1
+CDIR$ IVDEP
+         DO 103 I=3,IDO,2
+            IC = IDP2-I
+            CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
+            TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
+            CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
+            TI2 = CC(I,1,K)+CC(IC,2,K)
+            CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
+            CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
+  103    CONTINUE
+  104 CONTINUE
+      GO TO 111
+  108 DO 110 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 109 K=1,L1
+            CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
+            TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
+            CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
+            TI2 = CC(I,1,K)+CC(IC,2,K)
+            CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
+            CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
+  109    CONTINUE
+  110 CONTINUE
+  111 IF (MOD(IDO,2) .EQ. 1) RETURN
+  105 DO 106 K=1,L1
+         CH(IDO,K,1) = CC(IDO,1,K)+CC(IDO,1,K)
+         CH(IDO,K,2) = -(CC(1,2,K)+CC(1,2,K))
+  106 CONTINUE
+  107 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radb3.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radb3.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,85 @@
+*DECK RADB3
+      SUBROUTINE RADB3 (IDO, L1, CC, CH, WA1, WA2)
+C***BEGIN PROLOGUE  RADB3
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length three.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADB3-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing definition of variable TAUI by using
+C               FORTRAN intrinsic function SQRT instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADB3
+      DIMENSION CC(IDO,3,*), CH(IDO,L1,3), WA1(*), WA2(*)
+C***FIRST EXECUTABLE STATEMENT  RADB3
+      TAUR = -.5
+      TAUI = .5*SQRT(3.)
+      DO 101 K=1,L1
+         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+         CR2 = CC(1,1,K)+TAUR*TR2
+         CH(1,K,1) = CC(1,1,K)+TR2
+         CI3 = TAUI*(CC(1,3,K)+CC(1,3,K))
+         CH(1,K,2) = CR2-CI3
+         CH(1,K,3) = CR2+CI3
+  101 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 104
+      DO 103 K=1,L1
+CDIR$ IVDEP
+         DO 102 I=3,IDO,2
+            IC = IDP2-I
+            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+            CR2 = CC(I-1,1,K)+TAUR*TR2
+            CH(I-1,K,1) = CC(I-1,1,K)+TR2
+            TI2 = CC(I,3,K)-CC(IC,2,K)
+            CI2 = CC(I,1,K)+TAUR*TI2
+            CH(I,K,1) = CC(I,1,K)+TI2
+            CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
+            CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
+            DR2 = CR2-CI3
+            DR3 = CR2+CI3
+            DI2 = CI2+CR3
+            DI3 = CI2-CR3
+            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+  102    CONTINUE
+  103 CONTINUE
+      RETURN
+  104 DO 106 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 105 K=1,L1
+            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+            CR2 = CC(I-1,1,K)+TAUR*TR2
+            CH(I-1,K,1) = CC(I-1,1,K)+TR2
+            TI2 = CC(I,3,K)-CC(IC,2,K)
+            CI2 = CC(I,1,K)+TAUR*TI2
+            CH(I,K,1) = CC(I,1,K)+TI2
+            CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
+            CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
+            DR2 = CR2-CI3
+            DR3 = CR2+CI3
+            DI2 = CI2+CR3
+            DI3 = CI2-CR3
+            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radb4.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radb4.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,109 @@
+*DECK RADB4
+      SUBROUTINE RADB4 (IDO, L1, CC, CH, WA1, WA2, WA3)
+C***BEGIN PROLOGUE  RADB4
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length four.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADB4-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing definition of variable SQRT2 by using
+C               FORTRAN intrinsic function SQRT instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADB4
+      DIMENSION CC(IDO,4,*), CH(IDO,L1,4), WA1(*), WA2(*), WA3(*)
+C***FIRST EXECUTABLE STATEMENT  RADB4
+      SQRT2 = SQRT(2.)
+      DO 101 K=1,L1
+         TR1 = CC(1,1,K)-CC(IDO,4,K)
+         TR2 = CC(1,1,K)+CC(IDO,4,K)
+         TR3 = CC(IDO,2,K)+CC(IDO,2,K)
+         TR4 = CC(1,3,K)+CC(1,3,K)
+         CH(1,K,1) = TR2+TR3
+         CH(1,K,2) = TR1-TR4
+         CH(1,K,3) = TR2-TR3
+         CH(1,K,4) = TR1+TR4
+  101 CONTINUE
+      IF (IDO-2) 107,105,102
+  102 IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 108
+      DO 104 K=1,L1
+CDIR$ IVDEP
+         DO 103 I=3,IDO,2
+            IC = IDP2-I
+            TI1 = CC(I,1,K)+CC(IC,4,K)
+            TI2 = CC(I,1,K)-CC(IC,4,K)
+            TI3 = CC(I,3,K)-CC(IC,2,K)
+            TR4 = CC(I,3,K)+CC(IC,2,K)
+            TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
+            TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
+            TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
+            TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
+            CH(I-1,K,1) = TR2+TR3
+            CR3 = TR2-TR3
+            CH(I,K,1) = TI2+TI3
+            CI3 = TI2-TI3
+            CR2 = TR1-TR4
+            CR4 = TR1+TR4
+            CI2 = TI1+TI4
+            CI4 = TI1-TI4
+            CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
+            CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
+            CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
+            CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
+            CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
+            CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
+  103    CONTINUE
+  104 CONTINUE
+      GO TO 111
+  108 DO 110 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 109 K=1,L1
+            TI1 = CC(I,1,K)+CC(IC,4,K)
+            TI2 = CC(I,1,K)-CC(IC,4,K)
+            TI3 = CC(I,3,K)-CC(IC,2,K)
+            TR4 = CC(I,3,K)+CC(IC,2,K)
+            TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
+            TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
+            TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
+            TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
+            CH(I-1,K,1) = TR2+TR3
+            CR3 = TR2-TR3
+            CH(I,K,1) = TI2+TI3
+            CI3 = TI2-TI3
+            CR2 = TR1-TR4
+            CR4 = TR1+TR4
+            CI2 = TI1+TI4
+            CI4 = TI1-TI4
+            CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
+            CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
+            CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
+            CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
+            CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
+            CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
+  109    CONTINUE
+  110 CONTINUE
+  111 IF (MOD(IDO,2) .EQ. 1) RETURN
+  105 DO 106 K=1,L1
+         TI1 = CC(1,2,K)+CC(1,4,K)
+         TI2 = CC(1,4,K)-CC(1,2,K)
+         TR1 = CC(IDO,1,K)-CC(IDO,3,K)
+         TR2 = CC(IDO,1,K)+CC(IDO,3,K)
+         CH(IDO,K,1) = TR2+TR2
+         CH(IDO,K,2) = SQRT2*(TR1-TI1)
+         CH(IDO,K,3) = TI2+TI2
+         CH(IDO,K,4) = -SQRT2*(TR1+TI1)
+  106 CONTINUE
+  107 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radb5.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radb5.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,132 @@
+*DECK RADB5
+      SUBROUTINE RADB5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
+C***BEGIN PROLOGUE  RADB5
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length five.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADB5-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing definition of variables PI, TI11, TI12,
+C               TR11, TR12 by using FORTRAN intrinsic functions ATAN
+C               and SIN instead of DATA statements.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADB5
+      DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*),
+     +          WA4(*)
+C***FIRST EXECUTABLE STATEMENT  RADB5
+      PI = 4.*ATAN(1.)
+      TR11 = SIN(.1*PI)
+      TI11 = SIN(.4*PI)
+      TR12 = -SIN(.3*PI)
+      TI12 = SIN(.2*PI)
+      DO 101 K=1,L1
+         TI5 = CC(1,3,K)+CC(1,3,K)
+         TI4 = CC(1,5,K)+CC(1,5,K)
+         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+         TR3 = CC(IDO,4,K)+CC(IDO,4,K)
+         CH(1,K,1) = CC(1,1,K)+TR2+TR3
+         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
+         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
+         CI5 = TI11*TI5+TI12*TI4
+         CI4 = TI12*TI5-TI11*TI4
+         CH(1,K,2) = CR2-CI5
+         CH(1,K,3) = CR3-CI4
+         CH(1,K,4) = CR3+CI4
+         CH(1,K,5) = CR2+CI5
+  101 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 104
+      DO 103 K=1,L1
+CDIR$ IVDEP
+         DO 102 I=3,IDO,2
+            IC = IDP2-I
+            TI5 = CC(I,3,K)+CC(IC,2,K)
+            TI2 = CC(I,3,K)-CC(IC,2,K)
+            TI4 = CC(I,5,K)+CC(IC,4,K)
+            TI3 = CC(I,5,K)-CC(IC,4,K)
+            TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
+            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+            TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
+            TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
+            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+            CH(I,K,1) = CC(I,1,K)+TI2+TI3
+            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+            CR5 = TI11*TR5+TI12*TR4
+            CI5 = TI11*TI5+TI12*TI4
+            CR4 = TI12*TR5-TI11*TR4
+            CI4 = TI12*TI5-TI11*TI4
+            DR3 = CR3-CI4
+            DR4 = CR3+CI4
+            DI3 = CI3+CR4
+            DI4 = CI3-CR4
+            DR5 = CR2+CI5
+            DR2 = CR2-CI5
+            DI5 = CI2-CR5
+            DI2 = CI2+CR5
+            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+            CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
+            CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
+            CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
+            CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
+  102    CONTINUE
+  103 CONTINUE
+      RETURN
+  104 DO 106 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 105 K=1,L1
+            TI5 = CC(I,3,K)+CC(IC,2,K)
+            TI2 = CC(I,3,K)-CC(IC,2,K)
+            TI4 = CC(I,5,K)+CC(IC,4,K)
+            TI3 = CC(I,5,K)-CC(IC,4,K)
+            TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
+            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+            TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
+            TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
+            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+            CH(I,K,1) = CC(I,1,K)+TI2+TI3
+            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+            CR5 = TI11*TR5+TI12*TR4
+            CI5 = TI11*TI5+TI12*TI4
+            CR4 = TI12*TR5-TI11*TR4
+            CI4 = TI12*TI5-TI11*TI4
+            DR3 = CR3-CI4
+            DR4 = CR3+CI4
+            DI3 = CI3+CR4
+            DI4 = CI3-CR4
+            DR5 = CR2+CI5
+            DR2 = CR2-CI5
+            DI5 = CI2-CR5
+            DI2 = CI2+CR5
+            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+            CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
+            CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
+            CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
+            CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radbg.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radbg.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,189 @@
+*DECK RADBG
+      SUBROUTINE RADBG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
+C***BEGIN PROLOGUE  RADBG
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            arbitrary length.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADBG-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing references to intrinsic function FLOAT
+C               to REAL, and
+C           (c) changing definition of variable TPI by using
+C               FORTRAN intrinsic function ATAN instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADBG
+      DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
+     +          C2(IDL1,*), CH2(IDL1,*), WA(*)
+C***FIRST EXECUTABLE STATEMENT  RADBG
+      TPI = 8.*ATAN(1.)
+      ARG = TPI/IP
+      DCP = COS(ARG)
+      DSP = SIN(ARG)
+      IDP2 = IDO+2
+      NBD = (IDO-1)/2
+      IPP2 = IP+2
+      IPPH = (IP+1)/2
+      IF (IDO .LT. L1) GO TO 103
+      DO 102 K=1,L1
+         DO 101 I=1,IDO
+            CH(I,K,1) = CC(I,1,K)
+  101    CONTINUE
+  102 CONTINUE
+      GO TO 106
+  103 DO 105 I=1,IDO
+         DO 104 K=1,L1
+            CH(I,K,1) = CC(I,1,K)
+  104    CONTINUE
+  105 CONTINUE
+  106 DO 108 J=2,IPPH
+         JC = IPP2-J
+         J2 = J+J
+         DO 107 K=1,L1
+            CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
+            CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
+  107    CONTINUE
+  108 CONTINUE
+      IF (IDO .EQ. 1) GO TO 116
+      IF (NBD .LT. L1) GO TO 112
+      DO 111 J=2,IPPH
+         JC = IPP2-J
+         DO 110 K=1,L1
+CDIR$ IVDEP
+            DO 109 I=3,IDO,2
+               IC = IDP2-I
+               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+  109       CONTINUE
+  110    CONTINUE
+  111 CONTINUE
+      GO TO 116
+  112 DO 115 J=2,IPPH
+         JC = IPP2-J
+CDIR$ IVDEP
+         DO 114 I=3,IDO,2
+            IC = IDP2-I
+            DO 113 K=1,L1
+               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+  113       CONTINUE
+  114    CONTINUE
+  115 CONTINUE
+  116 AR1 = 1.
+      AI1 = 0.
+      DO 120 L=2,IPPH
+         LC = IPP2-L
+         AR1H = DCP*AR1-DSP*AI1
+         AI1 = DCP*AI1+DSP*AR1
+         AR1 = AR1H
+         DO 117 IK=1,IDL1
+            C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
+            C2(IK,LC) = AI1*CH2(IK,IP)
+  117    CONTINUE
+         DC2 = AR1
+         DS2 = AI1
+         AR2 = AR1
+         AI2 = AI1
+         DO 119 J=3,IPPH
+            JC = IPP2-J
+            AR2H = DC2*AR2-DS2*AI2
+            AI2 = DC2*AI2+DS2*AR2
+            AR2 = AR2H
+            DO 118 IK=1,IDL1
+               C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
+               C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
+  118       CONTINUE
+  119    CONTINUE
+  120 CONTINUE
+      DO 122 J=2,IPPH
+         DO 121 IK=1,IDL1
+            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
+  121    CONTINUE
+  122 CONTINUE
+      DO 124 J=2,IPPH
+         JC = IPP2-J
+         DO 123 K=1,L1
+            CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
+            CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
+  123    CONTINUE
+  124 CONTINUE
+      IF (IDO .EQ. 1) GO TO 132
+      IF (NBD .LT. L1) GO TO 128
+      DO 127 J=2,IPPH
+         JC = IPP2-J
+         DO 126 K=1,L1
+CDIR$ IVDEP
+            DO 125 I=3,IDO,2
+               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+  125       CONTINUE
+  126    CONTINUE
+  127 CONTINUE
+      GO TO 132
+  128 DO 131 J=2,IPPH
+         JC = IPP2-J
+         DO 130 I=3,IDO,2
+            DO 129 K=1,L1
+               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+  129       CONTINUE
+  130    CONTINUE
+  131 CONTINUE
+  132 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      DO 133 IK=1,IDL1
+         C2(IK,1) = CH2(IK,1)
+  133 CONTINUE
+      DO 135 J=2,IP
+         DO 134 K=1,L1
+            C1(1,K,J) = CH(1,K,J)
+  134    CONTINUE
+  135 CONTINUE
+      IF (NBD .GT. L1) GO TO 139
+      IS = -IDO
+      DO 138 J=2,IP
+         IS = IS+IDO
+         IDIJ = IS
+         DO 137 I=3,IDO,2
+            IDIJ = IDIJ+2
+            DO 136 K=1,L1
+               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+  136       CONTINUE
+  137    CONTINUE
+  138 CONTINUE
+      GO TO 143
+  139 IS = -IDO
+      DO 142 J=2,IP
+         IS = IS+IDO
+         DO 141 K=1,L1
+            IDIJ = IS
+CDIR$ IVDEP
+            DO 140 I=3,IDO,2
+               IDIJ = IDIJ+2
+               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+  140       CONTINUE
+  141    CONTINUE
+  142 CONTINUE
+  143 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radf2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radf2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,61 @@
+*DECK RADF2
+      SUBROUTINE RADF2 (IDO, L1, CC, CH, WA1)
+C***BEGIN PROLOGUE  RADF2
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length two.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADF2-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           changing dummy array size declarations (1) to (*).
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADF2
+      DIMENSION CH(IDO,2,*), CC(IDO,L1,2), WA1(*)
+C***FIRST EXECUTABLE STATEMENT  RADF2
+      DO 101 K=1,L1
+         CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
+         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
+  101 CONTINUE
+      IF (IDO-2) 107,105,102
+  102 IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 108
+      DO 104 K=1,L1
+CDIR$ IVDEP
+         DO 103 I=3,IDO,2
+            IC = IDP2-I
+            TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            CH(I,1,K) = CC(I,K,1)+TI2
+            CH(IC,2,K) = TI2-CC(I,K,1)
+            CH(I-1,1,K) = CC(I-1,K,1)+TR2
+            CH(IC-1,2,K) = CC(I-1,K,1)-TR2
+  103    CONTINUE
+  104 CONTINUE
+      GO TO 111
+  108 DO 110 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 109 K=1,L1
+            TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            CH(I,1,K) = CC(I,K,1)+TI2
+            CH(IC,2,K) = TI2-CC(I,K,1)
+            CH(I-1,1,K) = CC(I-1,K,1)+TR2
+            CH(IC-1,2,K) = CC(I-1,K,1)-TR2
+  109    CONTINUE
+  110 CONTINUE
+  111 IF (MOD(IDO,2) .EQ. 1) RETURN
+  105 DO 106 K=1,L1
+         CH(1,2,K) = -CC(IDO,K,2)
+         CH(IDO,1,K) = CC(IDO,K,1)
+  106 CONTINUE
+  107 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radf3.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radf3.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,83 @@
+*DECK RADF3
+      SUBROUTINE RADF3 (IDO, L1, CC, CH, WA1, WA2)
+C***BEGIN PROLOGUE  RADF3
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length three.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADF3-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing definition of variable TAUI by using
+C               FORTRAN intrinsic function SQRT instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADF3
+      DIMENSION CH(IDO,3,*), CC(IDO,L1,3), WA1(*), WA2(*)
+C***FIRST EXECUTABLE STATEMENT  RADF3
+      TAUR = -.5
+      TAUI = .5*SQRT(3.)
+      DO 101 K=1,L1
+         CR2 = CC(1,K,2)+CC(1,K,3)
+         CH(1,1,K) = CC(1,K,1)+CR2
+         CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2))
+         CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2
+  101 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 104
+      DO 103 K=1,L1
+CDIR$ IVDEP
+         DO 102 I=3,IDO,2
+            IC = IDP2-I
+            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            CR2 = DR2+DR3
+            CI2 = DI2+DI3
+            CH(I-1,1,K) = CC(I-1,K,1)+CR2
+            CH(I,1,K) = CC(I,K,1)+CI2
+            TR2 = CC(I-1,K,1)+TAUR*CR2
+            TI2 = CC(I,K,1)+TAUR*CI2
+            TR3 = TAUI*(DI2-DI3)
+            TI3 = TAUI*(DR3-DR2)
+            CH(I-1,3,K) = TR2+TR3
+            CH(IC-1,2,K) = TR2-TR3
+            CH(I,3,K) = TI2+TI3
+            CH(IC,2,K) = TI3-TI2
+  102    CONTINUE
+  103 CONTINUE
+      RETURN
+  104 DO 106 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 105 K=1,L1
+            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            CR2 = DR2+DR3
+            CI2 = DI2+DI3
+            CH(I-1,1,K) = CC(I-1,K,1)+CR2
+            CH(I,1,K) = CC(I,K,1)+CI2
+            TR2 = CC(I-1,K,1)+TAUR*CR2
+            TI2 = CC(I,K,1)+TAUR*CI2
+            TR3 = TAUI*(DI2-DI3)
+            TI3 = TAUI*(DR3-DR2)
+            CH(I-1,3,K) = TR2+TR3
+            CH(IC-1,2,K) = TR2-TR3
+            CH(I,3,K) = TI2+TI3
+            CH(IC,2,K) = TI3-TI2
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radf4.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radf4.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,105 @@
+*DECK RADF4
+      SUBROUTINE RADF4 (IDO, L1, CC, CH, WA1, WA2, WA3)
+C***BEGIN PROLOGUE  RADF4
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length four.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADF4-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*).
+C           (b) changing definition of variable HSQT2 by using
+C               FORTRAN intrinsic function SQRT instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADF4
+      DIMENSION CC(IDO,L1,4), CH(IDO,4,*), WA1(*), WA2(*), WA3(*)
+C***FIRST EXECUTABLE STATEMENT  RADF4
+      HSQT2 = .5*SQRT(2.)
+      DO 101 K=1,L1
+         TR1 = CC(1,K,2)+CC(1,K,4)
+         TR2 = CC(1,K,1)+CC(1,K,3)
+         CH(1,1,K) = TR1+TR2
+         CH(IDO,4,K) = TR2-TR1
+         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
+         CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
+  101 CONTINUE
+      IF (IDO-2) 107,105,102
+  102 IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 111
+      DO 104 K=1,L1
+CDIR$ IVDEP
+         DO 103 I=3,IDO,2
+            IC = IDP2-I
+            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+            TR1 = CR2+CR4
+            TR4 = CR4-CR2
+            TI1 = CI2+CI4
+            TI4 = CI2-CI4
+            TI2 = CC(I,K,1)+CI3
+            TI3 = CC(I,K,1)-CI3
+            TR2 = CC(I-1,K,1)+CR3
+            TR3 = CC(I-1,K,1)-CR3
+            CH(I-1,1,K) = TR1+TR2
+            CH(IC-1,4,K) = TR2-TR1
+            CH(I,1,K) = TI1+TI2
+            CH(IC,4,K) = TI1-TI2
+            CH(I-1,3,K) = TI4+TR3
+            CH(IC-1,2,K) = TR3-TI4
+            CH(I,3,K) = TR4+TI3
+            CH(IC,2,K) = TR4-TI3
+  103    CONTINUE
+  104 CONTINUE
+      GO TO 110
+  111 DO 109 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 108 K=1,L1
+            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+            TR1 = CR2+CR4
+            TR4 = CR4-CR2
+            TI1 = CI2+CI4
+            TI4 = CI2-CI4
+            TI2 = CC(I,K,1)+CI3
+            TI3 = CC(I,K,1)-CI3
+            TR2 = CC(I-1,K,1)+CR3
+            TR3 = CC(I-1,K,1)-CR3
+            CH(I-1,1,K) = TR1+TR2
+            CH(IC-1,4,K) = TR2-TR1
+            CH(I,1,K) = TI1+TI2
+            CH(IC,4,K) = TI1-TI2
+            CH(I-1,3,K) = TI4+TR3
+            CH(IC-1,2,K) = TR3-TI4
+            CH(I,3,K) = TR4+TI3
+            CH(IC,2,K) = TR4-TI3
+  108    CONTINUE
+  109 CONTINUE
+  110 IF (MOD(IDO,2) .EQ. 1) RETURN
+  105 DO 106 K=1,L1
+         TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
+         TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
+         CH(IDO,1,K) = TR1+CC(IDO,K,1)
+         CH(IDO,3,K) = CC(IDO,K,1)-TR1
+         CH(1,2,K) = TI1-CC(IDO,K,3)
+         CH(1,4,K) = TI1+CC(IDO,K,3)
+  106 CONTINUE
+  107 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radf5.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radf5.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,128 @@
+*DECK RADF5
+      SUBROUTINE RADF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
+C***BEGIN PROLOGUE  RADF5
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            length five.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADF5-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing definition of variables PI, TI11, TI12,
+C               TR11, TR12 by using FORTRAN intrinsic functions ATAN
+C               and SIN instead of DATA statements.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADF5
+      DIMENSION CC(IDO,L1,5), CH(IDO,5,*), WA1(*), WA2(*), WA3(*),
+     +          WA4(*)
+C***FIRST EXECUTABLE STATEMENT  RADF5
+      PI = 4.*ATAN(1.)
+      TR11 = SIN(.1*PI)
+      TI11 = SIN(.4*PI)
+      TR12 = -SIN(.3*PI)
+      TI12 = SIN(.2*PI)
+      DO 101 K=1,L1
+         CR2 = CC(1,K,5)+CC(1,K,2)
+         CI5 = CC(1,K,5)-CC(1,K,2)
+         CR3 = CC(1,K,4)+CC(1,K,3)
+         CI4 = CC(1,K,4)-CC(1,K,3)
+         CH(1,1,K) = CC(1,K,1)+CR2+CR3
+         CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
+         CH(1,3,K) = TI11*CI5+TI12*CI4
+         CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
+         CH(1,5,K) = TI12*CI5-TI11*CI4
+  101 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      IDP2 = IDO+2
+      IF((IDO-1)/2.LT.L1) GO TO 104
+      DO 103 K=1,L1
+CDIR$ IVDEP
+         DO 102 I=3,IDO,2
+            IC = IDP2-I
+            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+            DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+            DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
+            DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
+            CR2 = DR2+DR5
+            CI5 = DR5-DR2
+            CR5 = DI2-DI5
+            CI2 = DI2+DI5
+            CR3 = DR3+DR4
+            CI4 = DR4-DR3
+            CR4 = DI3-DI4
+            CI3 = DI3+DI4
+            CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
+            CH(I,1,K) = CC(I,K,1)+CI2+CI3
+            TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
+            TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
+            TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
+            TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
+            TR5 = TI11*CR5+TI12*CR4
+            TI5 = TI11*CI5+TI12*CI4
+            TR4 = TI12*CR5-TI11*CR4
+            TI4 = TI12*CI5-TI11*CI4
+            CH(I-1,3,K) = TR2+TR5
+            CH(IC-1,2,K) = TR2-TR5
+            CH(I,3,K) = TI2+TI5
+            CH(IC,2,K) = TI5-TI2
+            CH(I-1,5,K) = TR3+TR4
+            CH(IC-1,4,K) = TR3-TR4
+            CH(I,5,K) = TI3+TI4
+            CH(IC,4,K) = TI4-TI3
+  102    CONTINUE
+  103 CONTINUE
+      RETURN
+  104 DO 106 I=3,IDO,2
+         IC = IDP2-I
+CDIR$ IVDEP
+         DO 105 K=1,L1
+            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+            DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+            DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+            DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
+            DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
+            CR2 = DR2+DR5
+            CI5 = DR5-DR2
+            CR5 = DI2-DI5
+            CI2 = DI2+DI5
+            CR3 = DR3+DR4
+            CI4 = DR4-DR3
+            CR4 = DI3-DI4
+            CI3 = DI3+DI4
+            CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
+            CH(I,1,K) = CC(I,K,1)+CI2+CI3
+            TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
+            TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
+            TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
+            TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
+            TR5 = TI11*CR5+TI12*CR4
+            TI5 = TI11*CI5+TI12*CI4
+            TR4 = TI12*CR5-TI11*CR4
+            TI4 = TI12*CI5-TI11*CI4
+            CH(I-1,3,K) = TR2+TR5
+            CH(IC-1,2,K) = TR2-TR5
+            CH(I,3,K) = TI2+TI5
+            CH(IC,2,K) = TI5-TI2
+            CH(I-1,5,K) = TR3+TR4
+            CH(IC-1,4,K) = TR3-TR4
+            CH(I,5,K) = TI3+TI4
+            CH(IC,4,K) = TI4-TI3
+  105    CONTINUE
+  106 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/radfg.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/radfg.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,194 @@
+*DECK RADFG
+      SUBROUTINE RADFG (IDO, IP, L1, IDL1, CC, C1, C2, CH, CH2, WA)
+C***BEGIN PROLOGUE  RADFG
+C***SUBSIDIARY
+C***PURPOSE  Calculate the fast Fourier transform of subvectors of
+C            arbitrary length.
+C***LIBRARY   SLATEC (FFTPACK)
+C***TYPE      SINGLE PRECISION (RADFG-S)
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing references to intrinsic function FLOAT
+C               to REAL, and
+C           (c) changing definition of variable TPI by using
+C               FORTRAN intrinsic function ATAN instead of a DATA
+C               statement.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900402  Added TYPE section.  (WRB)
+C***END PROLOGUE  RADFG
+      DIMENSION CH(IDO,L1,*), CC(IDO,IP,*), C1(IDO,L1,*),
+     +          C2(IDL1,*), CH2(IDL1,*), WA(*)
+C***FIRST EXECUTABLE STATEMENT  RADFG
+      TPI = 8.*ATAN(1.)
+      ARG = TPI/IP
+      DCP = COS(ARG)
+      DSP = SIN(ARG)
+      IPPH = (IP+1)/2
+      IPP2 = IP+2
+      IDP2 = IDO+2
+      NBD = (IDO-1)/2
+      IF (IDO .EQ. 1) GO TO 119
+      DO 101 IK=1,IDL1
+         CH2(IK,1) = C2(IK,1)
+  101 CONTINUE
+      DO 103 J=2,IP
+         DO 102 K=1,L1
+            CH(1,K,J) = C1(1,K,J)
+  102    CONTINUE
+  103 CONTINUE
+      IF (NBD .GT. L1) GO TO 107
+      IS = -IDO
+      DO 106 J=2,IP
+         IS = IS+IDO
+         IDIJ = IS
+         DO 105 I=3,IDO,2
+            IDIJ = IDIJ+2
+            DO 104 K=1,L1
+               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+  104       CONTINUE
+  105    CONTINUE
+  106 CONTINUE
+      GO TO 111
+  107 IS = -IDO
+      DO 110 J=2,IP
+         IS = IS+IDO
+         DO 109 K=1,L1
+            IDIJ = IS
+CDIR$ IVDEP
+            DO 108 I=3,IDO,2
+               IDIJ = IDIJ+2
+               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+  108       CONTINUE
+  109    CONTINUE
+  110 CONTINUE
+  111 IF (NBD .LT. L1) GO TO 115
+      DO 114 J=2,IPPH
+         JC = IPP2-J
+         DO 113 K=1,L1
+CDIR$ IVDEP
+            DO 112 I=3,IDO,2
+               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+  112       CONTINUE
+  113    CONTINUE
+  114 CONTINUE
+      GO TO 121
+  115 DO 118 J=2,IPPH
+         JC = IPP2-J
+         DO 117 I=3,IDO,2
+            DO 116 K=1,L1
+               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+  116       CONTINUE
+  117    CONTINUE
+  118 CONTINUE
+      GO TO 121
+  119 DO 120 IK=1,IDL1
+         C2(IK,1) = CH2(IK,1)
+  120 CONTINUE
+  121 DO 123 J=2,IPPH
+         JC = IPP2-J
+         DO 122 K=1,L1
+            C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
+            C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
+  122    CONTINUE
+  123 CONTINUE
+C
+      AR1 = 1.
+      AI1 = 0.
+      DO 127 L=2,IPPH
+         LC = IPP2-L
+         AR1H = DCP*AR1-DSP*AI1
+         AI1 = DCP*AI1+DSP*AR1
+         AR1 = AR1H
+         DO 124 IK=1,IDL1
+            CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
+            CH2(IK,LC) = AI1*C2(IK,IP)
+  124    CONTINUE
+         DC2 = AR1
+         DS2 = AI1
+         AR2 = AR1
+         AI2 = AI1
+         DO 126 J=3,IPPH
+            JC = IPP2-J
+            AR2H = DC2*AR2-DS2*AI2
+            AI2 = DC2*AI2+DS2*AR2
+            AR2 = AR2H
+            DO 125 IK=1,IDL1
+               CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
+               CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
+  125       CONTINUE
+  126    CONTINUE
+  127 CONTINUE
+      DO 129 J=2,IPPH
+         DO 128 IK=1,IDL1
+            CH2(IK,1) = CH2(IK,1)+C2(IK,J)
+  128    CONTINUE
+  129 CONTINUE
+C
+      IF (IDO .LT. L1) GO TO 132
+      DO 131 K=1,L1
+         DO 130 I=1,IDO
+            CC(I,1,K) = CH(I,K,1)
+  130    CONTINUE
+  131 CONTINUE
+      GO TO 135
+  132 DO 134 I=1,IDO
+         DO 133 K=1,L1
+            CC(I,1,K) = CH(I,K,1)
+  133    CONTINUE
+  134 CONTINUE
+  135 DO 137 J=2,IPPH
+         JC = IPP2-J
+         J2 = J+J
+         DO 136 K=1,L1
+            CC(IDO,J2-2,K) = CH(1,K,J)
+            CC(1,J2-1,K) = CH(1,K,JC)
+  136    CONTINUE
+  137 CONTINUE
+      IF (IDO .EQ. 1) RETURN
+      IF (NBD .LT. L1) GO TO 141
+      DO 140 J=2,IPPH
+         JC = IPP2-J
+         J2 = J+J
+         DO 139 K=1,L1
+CDIR$ IVDEP
+            DO 138 I=3,IDO,2
+               IC = IDP2-I
+               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+  138       CONTINUE
+  139    CONTINUE
+  140 CONTINUE
+      RETURN
+  141 DO 144 J=2,IPPH
+         JC = IPP2-J
+         J2 = J+J
+         DO 143 I=3,IDO,2
+            IC = IDP2-I
+            DO 142 K=1,L1
+               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+  142       CONTINUE
+  143    CONTINUE
+  144 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rand.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rand.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,122 @@
+*DECK RAND
+      FUNCTION RAND (R)
+C***BEGIN PROLOGUE  RAND
+C***PURPOSE  Generate a uniformly distributed random number.
+C***LIBRARY   SLATEC (FNLIB)
+C***CATEGORY  L6A21
+C***TYPE      SINGLE PRECISION (RAND-S)
+C***KEYWORDS  FNLIB, RANDOM NUMBER, SPECIAL FUNCTIONS, UNIFORM
+C***AUTHOR  Fullerton, W., (LANL)
+C***DESCRIPTION
+C
+C      This pseudo-random number generator is portable among a wide
+C variety of computers.  RAND(R) undoubtedly is not as good as many
+C readily available installation dependent versions, and so this
+C routine is not recommended for widespread usage.  Its redeeming
+C feature is that the exact same random numbers (to within final round-
+C off error) can be generated from machine to machine.  Thus, programs
+C that make use of random numbers can be easily transported to and
+C checked in a new environment.
+C
+C      The random numbers are generated by the linear congruential
+C method described, e.g., by Knuth in Seminumerical Methods (p.9),
+C Addison-Wesley, 1969.  Given the I-th number of a pseudo-random
+C sequence, the I+1 -st number is generated from
+C             X(I+1) = (A*X(I) + C) MOD M,
+C where here M = 2**22 = 4194304, C = 1731 and several suitable values
+C of the multiplier A are discussed below.  Both the multiplier A and
+C random number X are represented in double precision as two 11-bit
+C words.  The constants are chosen so that the period is the maximum
+C possible, 4194304.
+C
+C      In order that the same numbers be generated from machine to
+C machine, it is necessary that 23-bit integers be reducible modulo
+C 2**11 exactly, that 23-bit integers be added exactly, and that 11-bit
+C integers be multiplied exactly.  Furthermore, if the restart option
+C is used (where R is between 0 and 1), then the product R*2**22 =
+C R*4194304 must be correct to the nearest integer.
+C
+C      The first four random numbers should be .0004127026,
+C .6750836372, .1614754200, and .9086198807.  The tenth random number
+C is .5527787209, and the hundredth is .3600893021 .  The thousandth
+C number should be .2176990509 .
+C
+C      In order to generate several effectively independent sequences
+C with the same generator, it is necessary to know the random number
+C for several widely spaced calls.  The I-th random number times 2**22,
+C where I=K*P/8 and P is the period of the sequence (P = 2**22), is
+C still of the form L*P/8.  In particular we find the I-th random
+C number multiplied by 2**22 is given by
+C I   =  0  1*P/8  2*P/8  3*P/8  4*P/8  5*P/8  6*P/8  7*P/8  8*P/8
+C RAND=  0  5*P/8  2*P/8  7*P/8  4*P/8  1*P/8  6*P/8  3*P/8  0
+C Thus the 4*P/8 = 2097152 random number is 2097152/2**22.
+C
+C      Several multipliers have been subjected to the spectral test
+C (see Knuth, p. 82).  Four suitable multipliers roughly in order of
+C goodness according to the spectral test are
+C    3146757 = 1536*2048 + 1029 = 2**21 + 2**20 + 2**10 + 5
+C    2098181 = 1024*2048 + 1029 = 2**21 + 2**10 + 5
+C    3146245 = 1536*2048 +  517 = 2**21 + 2**20 + 2**9 + 5
+C    2776669 = 1355*2048 + 1629 = 5**9 + 7**7 + 1
+C
+C      In the table below LOG10(NU(I)) gives roughly the number of
+C random decimal digits in the random numbers considered I at a time.
+C C is the primary measure of goodness.  In both cases bigger is better.
+C
+C                   LOG10 NU(I)              C(I)
+C       A       I=2  I=3  I=4  I=5    I=2  I=3  I=4  I=5
+C
+C    3146757    3.3  2.0  1.6  1.3    3.1  1.3  4.6  2.6
+C    2098181    3.3  2.0  1.6  1.2    3.2  1.3  4.6  1.7
+C    3146245    3.3  2.2  1.5  1.1    3.2  4.2  1.1  0.4
+C    2776669    3.3  2.1  1.6  1.3    2.5  2.0  1.9  2.6
+C   Best
+C    Possible   3.3  2.3  1.7  1.4    3.6  5.9  9.7  14.9
+C
+C             Input Argument --
+C R      If R=0., the next random number of the sequence is generated.
+C        If R .LT. 0., the last generated number will be returned for
+C          possible use in a restart procedure.
+C        If R .GT. 0., the sequence of random numbers will start with
+C          the seed R mod 1.  This seed is also returned as the value of
+C          RAND provided the arithmetic is done exactly.
+C
+C             Output Value --
+C RAND   a pseudo-random number between 0. and 1.
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   770401  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890531  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C***END PROLOGUE  RAND
+      SAVE IA1, IA0, IA1MA0, IC, IX1, IX0
+      DATA IA1, IA0, IA1MA0 /1536, 1029, 507/
+      DATA IC /1731/
+      DATA IX1, IX0 /0, 0/
+C***FIRST EXECUTABLE STATEMENT  RAND
+      IF (R.LT.0.) GO TO 10
+      IF (R.GT.0.) GO TO 20
+C
+C           A*X = 2**22*IA1*IX1 + 2**11*(IA1*IX1 + (IA1-IA0)*(IX0-IX1)
+C                   + IA0*IX0) + IA0*IX0
+C
+      IY0 = IA0*IX0
+      IY1 = IA1*IX1 + IA1MA0*(IX0-IX1) + IY0
+      IY0 = IY0 + IC
+      IX0 = MOD (IY0, 2048)
+      IY1 = IY1 + (IY0-IX0)/2048
+      IX1 = MOD (IY1, 2048)
+C
+ 10   RAND = IX1*2048 + IX0
+      RAND = RAND / 4194304.
+      RETURN
+C
+ 20   IX1 = MOD(R,1.)*4194304. + 0.5
+      IX0 = MOD (IX1, 2048)
+      IX1 = (IX1-IX0)/2048
+      GO TO 10
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rfftb1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rfftb1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,143 @@
+*DECK RFFTB1
+      SUBROUTINE RFFTB1 (N, C, CH, WA, IFAC)
+C***BEGIN PROLOGUE  RFFTB1
+C***PURPOSE  Compute the backward fast Fourier transform of a real
+C            coefficient array.
+C***LIBRARY   SLATEC (FFTPACK)
+C***CATEGORY  J1A1
+C***TYPE      SINGLE PRECISION (RFFTB1-S, CFFTB1-C)
+C***KEYWORDS  FFTPACK, FOURIER TRANSFORM
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C   Subroutine RFFTB1 computes the real periodic sequence from its
+C   Fourier coefficients (Fourier synthesis).  The transform is defined
+C   below at output parameter C.
+C
+C   The arrays WA and IFAC which are used by subroutine RFFTB1 must be
+C   initialized by calling subroutine RFFTI1.
+C
+C   Input Arguments
+C
+C   N       the length of the array R to be transformed.  The method
+C           is most efficient when N is a product of small primes.
+C           N may change so long as different work arrays are provided.
+C
+C   C       a real array of length N which contains the sequence
+C           to be transformed.
+C
+C   CH      a real work array of length at least N.
+C
+C   WA      a real work array which must be dimensioned at least N.
+C
+C   IFAC    an integer work array which must be dimensioned at least 15.
+C
+C           The WA and IFAC arrays must be initialized by calling
+C           subroutine RFFTI1, and different WA and IFAC arrays must be
+C           used for each different value of N.  This initialization
+C           does not have to be repeated so long as N remains unchanged.
+C           Thus subsequent transforms can be obtained faster than the
+C           first.  The same WA and IFAC arrays can be used by RFFTF1
+C           and RFFTB1.
+C
+C   Output Argument
+C
+C   C       For N even and for I = 1,...,N
+C
+C                C(I) = C(1)+(-1)**(I-1)*C(N)
+C
+C                     plus the sum from K=2 to K=N/2 of
+C
+C                      2.*C(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C                     -2.*C(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C           For N odd and for I = 1,...,N
+C
+C                C(I) = C(1) plus the sum from K=2 to K=(N+1)/2 of
+C
+C                     2.*C(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+C
+C                    -2.*C(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C   Notes:  This transform is unnormalized since a call of RFFTF1
+C           followed by a call of RFFTB1 will multiply the input
+C           sequence by N.
+C
+C           WA and IFAC contain initialization calculations which must
+C           not be destroyed between calls of subroutine RFFTF1 or
+C           RFFTB1.
+C
+C***REFERENCES  P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C                 Computations (G. Rodrigue, ed.), Academic Press,
+C                 1982, pp. 51-83.
+C***ROUTINES CALLED  RADB2, RADB3, RADB4, RADB5, RADBG
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           changing dummy array size declarations (1) to (*).
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900131  Routine changed from subsidiary to user-callable.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  RFFTB1
+      DIMENSION CH(*), C(*), WA(*), IFAC(*)
+C***FIRST EXECUTABLE STATEMENT  RFFTB1
+      NF = IFAC(2)
+      NA = 0
+      L1 = 1
+      IW = 1
+      DO 116 K1=1,NF
+         IP = IFAC(K1+2)
+         L2 = IP*L1
+         IDO = N/L2
+         IDL1 = IDO*L1
+         IF (IP .NE. 4) GO TO 103
+         IX2 = IW+IDO
+         IX3 = IX2+IDO
+         IF (NA .NE. 0) GO TO 101
+         CALL RADB4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+         GO TO 102
+  101    CALL RADB4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+  102    NA = 1-NA
+         GO TO 115
+  103    IF (IP .NE. 2) GO TO 106
+         IF (NA .NE. 0) GO TO 104
+         CALL RADB2 (IDO,L1,C,CH,WA(IW))
+         GO TO 105
+  104    CALL RADB2 (IDO,L1,CH,C,WA(IW))
+  105    NA = 1-NA
+         GO TO 115
+  106    IF (IP .NE. 3) GO TO 109
+         IX2 = IW+IDO
+         IF (NA .NE. 0) GO TO 107
+         CALL RADB3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+         GO TO 108
+  107    CALL RADB3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+  108    NA = 1-NA
+         GO TO 115
+  109    IF (IP .NE. 5) GO TO 112
+         IX2 = IW+IDO
+         IX3 = IX2+IDO
+         IX4 = IX3+IDO
+         IF (NA .NE. 0) GO TO 110
+         CALL RADB5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+         GO TO 111
+  110    CALL RADB5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+  111    NA = 1-NA
+         GO TO 115
+  112    IF (NA .NE. 0) GO TO 113
+         CALL RADBG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+         GO TO 114
+  113    CALL RADBG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+  114    IF (IDO .EQ. 1) NA = 1-NA
+  115    L1 = L2
+         IW = IW+(IP-1)*IDO
+  116 CONTINUE
+      IF (NA .EQ. 0) RETURN
+      DO 117 I=1,N
+         C(I) = CH(I)
+  117 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rfftf1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rfftf1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,144 @@
+*DECK RFFTF1
+      SUBROUTINE RFFTF1 (N, C, CH, WA, IFAC)
+C***BEGIN PROLOGUE  RFFTF1
+C***PURPOSE  Compute the forward transform of a real, periodic sequence.
+C***LIBRARY   SLATEC (FFTPACK)
+C***CATEGORY  J1A1
+C***TYPE      SINGLE PRECISION (RFFTF1-S, CFFTF1-C)
+C***KEYWORDS  FFTPACK, FOURIER TRANSFORM
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C   Subroutine RFFTF1 computes the Fourier coefficients of a real
+C   periodic sequence (Fourier analysis).  The transform is defined
+C   below at output parameter C.
+C
+C   The arrays WA and IFAC which are used by subroutine RFFTB1 must be
+C   initialized by calling subroutine RFFTI1.
+C
+C   Input Arguments
+C
+C   N       the length of the array R to be transformed.  The method
+C           is most efficient when N is a product of small primes.
+C           N may change so long as different work arrays are provided.
+C
+C   C       a real array of length N which contains the sequence
+C           to be transformed.
+C
+C   CH      a real work array of length at least N.
+C
+C   WA      a real work array which must be dimensioned at least N.
+C
+C   IFAC    an integer work array which must be dimensioned at least 15.
+C
+C           The WA and IFAC arrays must be initialized by calling
+C           subroutine RFFTI1, and different WA and IFAC arrays must be
+C           used for each different value of N.  This initialization
+C           does not have to be repeated so long as N remains unchanged.
+C           Thus subsequent transforms can be obtained faster than the
+C           first.  The same WA and IFAC arrays can be used by RFFTF1
+C           and RFFTB1.
+C
+C   Output Argument
+C
+C   C       C(1) = the sum from I=1 to I=N of R(I)
+C
+C           If N is even set L = N/2; if N is odd set L = (N+1)/2
+C
+C             then for K = 2,...,L
+C
+C                C(2*K-2) = the sum from I = 1 to I = N of
+C
+C                     C(I)*COS((K-1)*(I-1)*2*PI/N)
+C
+C                C(2*K-1) = the sum from I = 1 to I = N of
+C
+C                    -C(I)*SIN((K-1)*(I-1)*2*PI/N)
+C
+C           If N is even
+C
+C                C(N) = the sum from I = 1 to I = N of
+C
+C                     (-1)**(I-1)*C(I)
+C
+C   Notes:  This transform is unnormalized since a call of RFFTF1
+C           followed by a call of RFFTB1 will multiply the input
+C           sequence by N.
+C
+C           WA and IFAC contain initialization calculations which must
+C           not be destroyed between calls of subroutine RFFTF1 or
+C           RFFTB1.
+C
+C***REFERENCES  P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C                 Computations (G. Rodrigue, ed.), Academic Press,
+C                 1982, pp. 51-83.
+C***ROUTINES CALLED  RADF2, RADF3, RADF4, RADF5, RADFG
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           changing dummy array size declarations (1) to (*).
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900131  Routine changed from subsidiary to user-callable.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  RFFTF1
+      DIMENSION CH(*), C(*), WA(*), IFAC(*)
+C***FIRST EXECUTABLE STATEMENT  RFFTF1
+      NF = IFAC(2)
+      NA = 1
+      L2 = N
+      IW = N
+      DO 111 K1=1,NF
+         KH = NF-K1
+         IP = IFAC(KH+3)
+         L1 = L2/IP
+         IDO = N/L2
+         IDL1 = IDO*L1
+         IW = IW-(IP-1)*IDO
+         NA = 1-NA
+         IF (IP .NE. 4) GO TO 102
+         IX2 = IW+IDO
+         IX3 = IX2+IDO
+         IF (NA .NE. 0) GO TO 101
+         CALL RADF4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+         GO TO 110
+  101    CALL RADF4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+         GO TO 110
+  102    IF (IP .NE. 2) GO TO 104
+         IF (NA .NE. 0) GO TO 103
+         CALL RADF2 (IDO,L1,C,CH,WA(IW))
+         GO TO 110
+  103    CALL RADF2 (IDO,L1,CH,C,WA(IW))
+         GO TO 110
+  104    IF (IP .NE. 3) GO TO 106
+         IX2 = IW+IDO
+         IF (NA .NE. 0) GO TO 105
+         CALL RADF3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+         GO TO 110
+  105    CALL RADF3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+         GO TO 110
+  106    IF (IP .NE. 5) GO TO 108
+         IX2 = IW+IDO
+         IX3 = IX2+IDO
+         IX4 = IX3+IDO
+         IF (NA .NE. 0) GO TO 107
+         CALL RADF5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+         GO TO 110
+  107    CALL RADF5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+         GO TO 110
+  108    IF (IDO .EQ. 1) NA = 1-NA
+         IF (NA .NE. 0) GO TO 109
+         CALL RADFG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+         NA = 1
+         GO TO 110
+  109    CALL RADFG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+         NA = 0
+  110    L2 = L1
+  111 CONTINUE
+      IF (NA .EQ. 1) RETURN
+      DO 112 I=1,N
+         C(I) = CH(I)
+  112 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rffti1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rffti1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,110 @@
+*DECK RFFTI1
+      SUBROUTINE RFFTI1 (N, WA, IFAC)
+C***BEGIN PROLOGUE  RFFTI1
+C***PURPOSE  Initialize a real and an integer work array for RFFTF1 and
+C            RFFTB1.
+C***LIBRARY   SLATEC (FFTPACK)
+C***CATEGORY  J1A1
+C***TYPE      SINGLE PRECISION (RFFTI1-S, CFFTI1-C)
+C***KEYWORDS  FFTPACK, FOURIER TRANSFORM
+C***AUTHOR  Swarztrauber, P. N., (NCAR)
+C***DESCRIPTION
+C
+C   Subroutine RFFTI1 initializes the work arrays WA and IFAC which are
+C   used in both RFFTF1 and RFFTB1.  The prime factorization of N and a
+C   tabulation of the trigonometric functions are computed and stored in
+C   IFAC and WA, respectively.
+C
+C   Input Argument
+C
+C   N       the length of the sequence to be transformed.
+C
+C   Output Arguments
+C
+C   WA      a real work array which must be dimensioned at least N.
+C
+C   IFAC    an integer work array which must be dimensioned at least 15.
+C
+C   The same work arrays can be used for both RFFTF1 and RFFTB1 as long
+C   as N remains unchanged.  Different WA and IFAC arrays are required
+C   for different values of N.  The contents of WA and IFAC must not be
+C   changed between calls of RFFTF1 or RFFTB1.
+C
+C***REFERENCES  P. N. Swarztrauber, Vectorizing the FFTs, in Parallel
+C                 Computations (G. Rodrigue, ed.), Academic Press,
+C                 1982, pp. 51-83.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790601  DATE WRITTEN
+C   830401  Modified to use SLATEC library source file format.
+C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
+C           (a) changing dummy array size declarations (1) to (*),
+C           (b) changing references to intrinsic function FLOAT
+C               to REAL, and
+C           (c) changing definition of variable TPI by using
+C               FORTRAN intrinsic functions instead of DATA
+C               statements.
+C   881128  Modified by Dick Valent to meet prologue standards.
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900131  Routine changed from subsidiary to user-callable.  (WRB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  RFFTI1
+      DIMENSION WA(*), IFAC(*), NTRYH(4)
+      SAVE NTRYH
+      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
+C***FIRST EXECUTABLE STATEMENT  RFFTI1
+      NL = N
+      NF = 0
+      J = 0
+  101 J = J+1
+      IF (J-4) 102,102,103
+  102 NTRY = NTRYH(J)
+      GO TO 104
+  103 NTRY = NTRY+2
+  104 NQ = NL/NTRY
+      NR = NL-NTRY*NQ
+      IF (NR) 101,105,101
+  105 NF = NF+1
+      IFAC(NF+2) = NTRY
+      NL = NQ
+      IF (NTRY .NE. 2) GO TO 107
+      IF (NF .EQ. 1) GO TO 107
+      DO 106 I=2,NF
+         IB = NF-I+2
+         IFAC(IB+2) = IFAC(IB+1)
+  106 CONTINUE
+      IFAC(3) = 2
+  107 IF (NL .NE. 1) GO TO 104
+      IFAC(1) = N
+      IFAC(2) = NF
+      TPI = 8.*ATAN(1.)
+      ARGH = TPI/N
+      IS = 0
+      NFM1 = NF-1
+      L1 = 1
+      IF (NFM1 .EQ. 0) RETURN
+      DO 110 K1=1,NFM1
+         IP = IFAC(K1+2)
+         LD = 0
+         L2 = L1*IP
+         IDO = N/L2
+         IPM = IP-1
+         DO 109 J=1,IPM
+            LD = LD+L1
+            I = IS
+            ARGLD = LD*ARGH
+            FI = 0.
+            DO 108 II=3,IDO,2
+               I = I+2
+               FI = FI+1.
+               ARG = FI*ARGLD
+               WA(I-1) = COS(ARG)
+               WA(I) = SIN(ARG)
+  108       CONTINUE
+            IS = IS+IDO
+  109    CONTINUE
+         L1 = L2
+  110 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rgauss.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rgauss.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,43 @@
+*DECK RGAUSS
+      FUNCTION RGAUSS (XMEAN, SD)
+C***BEGIN PROLOGUE  RGAUSS
+C***PURPOSE  Generate a normally distributed (Gaussian) random number.
+C***LIBRARY   SLATEC (FNLIB)
+C***CATEGORY  L6A14
+C***TYPE      SINGLE PRECISION (RGAUSS-S)
+C***KEYWORDS  FNLIB, GAUSSIAN, NORMAL, RANDOM NUMBER, SPECIAL FUNCTIONS
+C***AUTHOR  Fullerton, W., (LANL)
+C***DESCRIPTION
+C
+C Generate a normally distributed random number, i.e., generate random
+C numbers with a Gaussian distribution.  These random numbers are not
+C exceptionally good -- especially in the tails of the distribution,
+C but this implementation is simple and suitable for most applications.
+C See R. W. Hamming, Numerical Methods for Scientists and Engineers,
+C McGraw-Hill, 1962, pages 34 and 389.
+C
+C             Input Arguments --
+C XMEAN  the mean of the Guassian distribution.
+C SD     the standard deviation of the Guassian function
+C          EXP (-1/2 * (X-XMEAN)**2 / SD**2)
+C
+C***REFERENCES  (NONE)
+C***ROUTINES CALLED  RAND
+C***REVISION HISTORY  (YYMMDD)
+C   770401  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   910819  Added EXTERNAL statement for RAND due to problem on IBM
+C           RS 6000.  (WRB)
+C***END PROLOGUE  RGAUSS
+      EXTERNAL RAND
+C***FIRST EXECUTABLE STATEMENT  RGAUSS
+      RGAUSS = -6.0
+      DO 10 I=1,12
+        RGAUSS = RGAUSS + RAND(0.0)
+ 10   CONTINUE
+C
+      RGAUSS = XMEAN + SD*RGAUSS
+C
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rs.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rs.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,90 @@
+*DECK RS
+      SUBROUTINE RS (NM, N, A, W, MATZ, Z, FV1, FV2, IERR)
+C***BEGIN PROLOGUE  RS
+C***PURPOSE  Compute the eigenvalues and, optionally, the eigenvectors
+C            of a real symmetric matrix.
+C***LIBRARY   SLATEC (EISPACK)
+C***CATEGORY  D4A1
+C***TYPE      SINGLE PRECISION (RS-S, CH-C)
+C***KEYWORDS  EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR  Smith, B. T., et al.
+C***DESCRIPTION
+C
+C     This subroutine calls the recommended sequence of
+C     subroutines from the eigensystem subroutine package (EISPACK)
+C     to find the eigenvalues and eigenvectors (if desired)
+C     of a REAL SYMMETRIC matrix.
+C
+C     On Input
+C
+C        NM must be set to the row dimension of the two-dimensional
+C          array parameters, A and Z, as declared in the calling
+C          program dimension statement.  NM is an INTEGER variable.
+C
+C        N is the order of the matrix A.  N is an INTEGER variable.
+C          N must be less than or equal to NM.
+C
+C        A contains the real symmetric matrix.  A is a two-dimensional
+C          REAL array, dimensioned A(NM,N).
+C
+C        MATZ is an INTEGER variable set equal to zero if only
+C          eigenvalues are desired.  Otherwise, it is set to any
+C          non-zero integer for both eigenvalues and eigenvectors.
+C
+C     On Output
+C
+C        A is unaltered.
+C
+C        W contains the eigenvalues in ascending order.  W is a one-
+C          dimensional REAL array, dimensioned W(N).
+C
+C        Z contains the eigenvectors if MATZ is not zero.  The
+C          eigenvectors are orthonormal.  Z is a two-dimensional
+C          REAL array, dimensioned Z(NM,N).
+C
+C        IERR is an INTEGER flag set to
+C          Zero       for normal return,
+C          10*N       if N is greater than NM,
+C          J          if the J-th eigenvalue has not been
+C                     determined after 30 iterations.
+C                     The eigenvalues, and eigenvectors if requested,
+C                     should be correct for indices 1, 2, ..., IERR-1.
+C
+C        FV1 and FV2 are one-dimensional REAL arrays used for temporary
+C          storage, dimensioned FV1(N) and FV2(N).
+C
+C     Questions and comments should be directed to B. S. Garbow,
+C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C     ------------------------------------------------------------------
+C
+C***REFERENCES  B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C                 Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C                 system Routines - EISPACK Guide, Springer-Verlag,
+C                 1976.
+C***ROUTINES CALLED  TQL2, TQLRAT, TRED1, TRED2
+C***REVISION HISTORY  (YYMMDD)
+C   760101  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  RS
+C
+      INTEGER N,NM,IERR,MATZ
+      REAL A(NM,*),W(*),Z(NM,*),FV1(*),FV2(*)
+C
+C***FIRST EXECUTABLE STATEMENT  RS
+      IF (N .LE. NM) GO TO 10
+      IERR = 10 * N
+      GO TO 50
+C
+   10 IF (MATZ .NE. 0) GO TO 20
+C     .......... FIND EIGENVALUES ONLY ..........
+      CALL  TRED1(NM,N,A,W,FV1,FV2)
+      CALL  TQLRAT(N,W,FV2,IERR)
+      GO TO 50
+C     .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
+   20 CALL  TRED2(NM,N,A,W,FV1,Z)
+      CALL  TQL2(NM,N,W,FV1,Z,IERR)
+   50 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/rwupdt.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/rwupdt.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,120 @@
+*DECK RWUPDT
+      SUBROUTINE RWUPDT (N, R, LDR, W, B, ALPHA, COS, SIN)
+C***BEGIN PROLOGUE  RWUPDT
+C***SUBSIDIARY
+C***PURPOSE  Subsidiary to SNLS1 and SNLS1E
+C***LIBRARY   SLATEC
+C***TYPE      SINGLE PRECISION (RWUPDT-S, DWUPDT-D)
+C***AUTHOR  (UNKNOWN)
+C***DESCRIPTION
+C
+C     Given an N by N upper triangular matrix R, this subroutine
+C     computes the QR decomposition of the matrix formed when a row
+C     is added to R. If the row is specified by the vector W, then
+C     RWUPDT determines an orthogonal matrix Q such that when the
+C     N+1 by N matrix composed of R augmented by W is premultiplied
+C     by (Q TRANSPOSE), the resulting matrix is upper trapezoidal.
+C     The orthogonal matrix Q is the product of N transformations
+C
+C           G(1)*G(2)* ... *G(N)
+C
+C     where G(I) is a Givens rotation in the (I,N+1) plane which
+C     eliminates elements in the I-th plane. RWUPDT also
+C     computes the product (Q TRANSPOSE)*C where C is the
+C     (N+1)-vector (b,alpha). Q itself is not accumulated, rather
+C     the information to recover the G rotations is supplied.
+C
+C     The subroutine statement is
+C
+C       SUBROUTINE RWUPDT(N,R,LDR,W,B,ALPHA,COS,SIN)
+C
+C     where
+C
+C       N is a positive integer input variable set to the order of R.
+C
+C       R is an N by N array. On input the upper triangular part of
+C         R must contain the matrix to be updated. On output R
+C         contains the updated triangular matrix.
+C
+C       LDR is a positive integer input variable not less than N
+C         which specifies the leading dimension of the array R.
+C
+C       W is an input array of length N which must contain the row
+C         vector to be added to R.
+C
+C       B is an array of length N. On input B must contain the
+C         first N elements of the vector C. On output B contains
+C         the first N elements of the vector (Q TRANSPOSE)*C.
+C
+C       ALPHA is a variable. On input ALPHA must contain the
+C         (N+1)-st element of the vector C. On output ALPHA contains
+C         the (N+1)-st element of the vector (Q TRANSPOSE)*C.
+C
+C       COS is an output array of length N which contains the
+C         cosines of the transforming Givens rotations.
+C
+C       SIN is an output array of length N which contains the
+C         sines of the transforming Givens rotations.
+C
+C***SEE ALSO  SNLS1, SNLS1E
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900326  Removed duplicate information from DESCRIPTION section.
+C           (WRB)
+C   900328  Added TYPE section.  (WRB)
+C***END PROLOGUE  RWUPDT
+      INTEGER N,LDR
+      REAL ALPHA
+      REAL R(LDR,*),W(*),B(*),COS(*),SIN(*)
+      INTEGER I,J,JM1
+      REAL COTAN,ONE,P5,P25,ROWJ,TAN,TEMP,ZERO
+      SAVE ONE, P5, P25, ZERO
+      DATA ONE,P5,P25,ZERO /1.0E0,5.0E-1,2.5E-1,0.0E0/
+C***FIRST EXECUTABLE STATEMENT  RWUPDT
+      DO 60 J = 1, N
+         ROWJ = W(J)
+         JM1 = J - 1
+C
+C        APPLY THE PREVIOUS TRANSFORMATIONS TO
+C        R(I,J), I=1,2,...,J-1, AND TO W(J).
+C
+         IF (JM1 .LT. 1) GO TO 20
+         DO 10 I = 1, JM1
+            TEMP = COS(I)*R(I,J) + SIN(I)*ROWJ
+            ROWJ = -SIN(I)*R(I,J) + COS(I)*ROWJ
+            R(I,J) = TEMP
+   10       CONTINUE
+   20    CONTINUE
+C
+C        DETERMINE A GIVENS ROTATION WHICH ELIMINATES W(J).
+C
+         COS(J) = ONE
+         SIN(J) = ZERO
+         IF (ROWJ .EQ. ZERO) GO TO 50
+         IF (ABS(R(J,J)) .GE. ABS(ROWJ)) GO TO 30
+            COTAN = R(J,J)/ROWJ
+            SIN(J) = P5/SQRT(P25+P25*COTAN**2)
+            COS(J) = SIN(J)*COTAN
+            GO TO 40
+   30    CONTINUE
+            TAN = ROWJ/R(J,J)
+            COS(J) = P5/SQRT(P25+P25*TAN**2)
+            SIN(J) = COS(J)*TAN
+   40    CONTINUE
+C
+C        APPLY THE CURRENT TRANSFORMATION TO R(J,J), B(J), AND ALPHA.
+C
+         R(J,J) = COS(J)*R(J,J) + SIN(J)*ROWJ
+         TEMP = COS(J)*B(J) + SIN(J)*ALPHA
+         ALPHA = -SIN(J)*B(J) + COS(J)*ALPHA
+         B(J) = TEMP
+   50    CONTINUE
+   60    CONTINUE
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE RWUPDT.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/snls1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/snls1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,1023 @@
+*DECK SNLS1
+      SUBROUTINE SNLS1 (FCN, IOPT, M, N, X, FVEC, FJAC, LDFJAC, FTOL,
+     +   XTOL, GTOL, MAXFEV, EPSFCN, DIAG, MODE, FACTOR, NPRINT, INFO,
+     +   NFEV, NJEV, IPVT, QTF, WA1, WA2, WA3, WA4)
+C***BEGIN PROLOGUE  SNLS1
+C***PURPOSE  Minimize the sum of the squares of M nonlinear functions
+C            in N variables by a modification of the Levenberg-Marquardt
+C            algorithm.
+C***LIBRARY   SLATEC
+C***CATEGORY  K1B1A1, K1B1A2
+C***TYPE      SINGLE PRECISION (SNLS1-S, DNLS1-D)
+C***KEYWORDS  LEVENBERG-MARQUARDT, NONLINEAR DATA FITTING,
+C             NONLINEAR LEAST SQUARES
+C***AUTHOR  Hiebert, K. L., (SNLA)
+C***DESCRIPTION
+C
+C 1. Purpose.
+C
+C       The purpose of SNLS1 is to minimize the sum of the squares of M
+C       nonlinear functions in N variables by a modification of the
+C       Levenberg-Marquardt algorithm.  The user must provide a subrou-
+C       tine which calculates the functions.  The user has the option
+C       of how the Jacobian will be supplied.  The user can supply the
+C       full Jacobian, or the rows of the Jacobian (to avoid storing
+C       the full Jacobian), or let the code approximate the Jacobian by
+C       forward-differencing.   This code is the combination of the
+C       MINPACK codes (Argonne) LMDER, LMDIF, and LMSTR.
+C
+C
+C 2. Subroutine and Type Statements.
+C
+C       SUBROUTINE SNLS1(FCN,IOPT,M,N,X,FVEC,FJAC,LDFJAC,FTOL,XTOL,
+C      *                 GTOL,MAXFEV,EPSFCN,DIAG,MODE,FACTOR,NPRINT,INFO
+C      *                 ,NFEV,NJEV,IPVT,QTF,WA1,WA2,WA3,WA4)
+C       INTEGER IOPT,M,N,LDFJAC,MAXFEV,MODE,NPRINT,INFO,NFEV,NJEV
+C       INTEGER IPVT(N)
+C       REAL FTOL,XTOL,GTOL,EPSFCN,FACTOR
+C       REAL X(N),FVEC(M),FJAC(LDFJAC,N),DIAG(N),QTF(N),
+C      *     WA1(N),WA2(N),WA3(N),WA4(M)
+C
+C
+C 3. Parameters.
+C
+C       Parameters designated as input parameters must be specified on
+C       entry to SNLS1 and are not changed on exit, while parameters
+C       designated as output parameters need not be specified on entry
+C       and are set to appropriate values on exit from SNLS1.
+C
+C       FCN is the name of the user-supplied subroutine which calculates
+C         the functions.  If the user wants to supply the Jacobian
+C         (IOPT=2 or 3), then FCN must be written to calculate the
+C         Jacobian, as well as the functions.  See the explanation
+C         of the IOPT argument below.
+C         If the user wants the iterates printed (NPRINT positive), then
+C         FCN must do the printing.  See the explanation of NPRINT
+C         below.  FCN must be declared in an EXTERNAL statement in the
+C         calling program and should be written as follows.
+C
+C
+C         SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
+C         INTEGER IFLAG,LDFJAC,M,N
+C         REAL X(N),FVEC(M)
+C         ----------
+C         FJAC and LDFJAC may be ignored     , if IOPT=1.
+C         REAL FJAC(LDFJAC,N)                , if IOPT=2.
+C         REAL FJAC(N)                       , if IOPT=3.
+C         ----------
+C           If IFLAG=0, the values in X and FVEC are available
+C           for printing.  See the explanation of NPRINT below.
+C           IFLAG will never be zero unless NPRINT is positive.
+C           The values of X and FVEC must not be changed.
+C         RETURN
+C         ----------
+C           If IFLAG=1, calculate the functions at X and return
+C           this vector in FVEC.
+C         RETURN
+C         ----------
+C           If IFLAG=2, calculate the full Jacobian at X and return
+C           this matrix in FJAC.  Note that IFLAG will never be 2 unless
+C           IOPT=2.  FVEC contains the function values at X and must
+C           not be altered.  FJAC(I,J) must be set to the derivative
+C           of FVEC(I) with respect to X(J).
+C         RETURN
+C         ----------
+C           If IFLAG=3, calculate the LDFJAC-th row of the Jacobian
+C           and return this vector in FJAC.  Note that IFLAG will
+C           never be 3 unless IOPT=3.  FVEC contains the function
+C           values at X and must not be altered.  FJAC(J) must be
+C           set to the derivative of FVEC(LDFJAC) with respect to X(J).
+C         RETURN
+C         ----------
+C         END
+C
+C
+C         The value of IFLAG should not be changed by FCN unless the
+C         user wants to terminate execution of SNLS1.  In this case, set
+C         IFLAG to a negative integer.
+C
+C
+C       IOPT is an input variable which specifies how the Jacobian will
+C         be calculated.  If IOPT=2 or 3, then the user must supply the
+C         Jacobian, as well as the function values, through the
+C         subroutine FCN.  If IOPT=2, the user supplies the full
+C         Jacobian with one call to FCN.  If IOPT=3, the user supplies
+C         one row of the Jacobian with each call.  (In this manner,
+C         storage can be saved because the full Jacobian is not stored.)
+C         If IOPT=1, the code will approximate the Jacobian by forward
+C         differencing.
+C
+C       M is a positive integer input variable set to the number of
+C         functions.
+C
+C       N is a positive integer input variable set to the number of
+C         variables.  N must not exceed M.
+C
+C       X is an array of length N.  On input, X must contain an initial
+C         estimate of the solution vector.  On output, X contains the
+C         final estimate of the solution vector.
+C
+C       FVEC is an output array of length M which contains the functions
+C         evaluated at the output X.
+C
+C       FJAC is an output array.  For IOPT=1 and 2, FJAC is an M by N
+C         array.  For IOPT=3, FJAC is an N by N array.  The upper N by N
+C         submatrix of FJAC contains an upper triangular matrix R with
+C         diagonal elements of nonincreasing magnitude such that
+C
+C                T     T           T
+C               P *(JAC *JAC)*P = R *R,
+C
+C         where P is a permutation matrix and JAC is the final calcu-
+C         lated Jacobian.  Column J of P is column IPVT(J) (see below)
+C         of the identity matrix.  The lower part of FJAC contains
+C         information generated during the computation of R.
+C
+C       LDFJAC is a positive integer input variable which specifies
+C         the leading dimension of the array FJAC.  For IOPT=1 and 2,
+C         LDFJAC must not be less than M.  For IOPT=3, LDFJAC must not
+C         be less than N.
+C
+C       FTOL is a non-negative input variable.  Termination occurs when
+C         both the actual and predicted relative reductions in the sum
+C         of squares are at most FTOL.  Therefore, FTOL measures the
+C         relative error desired in the sum of squares.  Section 4 con-
+C         tains more details about FTOL.
+C
+C       XTOL is a non-negative input variable.  Termination occurs when
+C         the relative error between two consecutive iterates is at most
+C         XTOL.  Therefore, XTOL measures the relative error desired in
+C         the approximate solution.  Section 4 contains more details
+C         about XTOL.
+C
+C       GTOL is a non-negative input variable.  Termination occurs when
+C         the cosine of the angle between FVEC and any column of the
+C         Jacobian is at most GTOL in absolute value.  Therefore, GTOL
+C         measures the orthogonality desired between the function vector
+C         and the columns of the Jacobian.  Section 4 contains more
+C         details about GTOL.
+C
+C       MAXFEV is a positive integer input variable.  Termination occurs
+C         when the number of calls to FCN to evaluate the functions
+C         has reached MAXFEV.
+C
+C       EPSFCN is an input variable used in determining a suitable step
+C         for the forward-difference approximation.  This approximation
+C         assumes that the relative errors in the functions are of the
+C         order of EPSFCN.  If EPSFCN is less than the machine preci-
+C         sion, it is assumed that the relative errors in the functions
+C         are of the order of the machine precision.  If IOPT=2 or 3,
+C         then EPSFCN can be ignored (treat it as a dummy argument).
+C
+C       DIAG is an array of length N.  If MODE = 1 (see below), DIAG is
+C         internally set.  If MODE = 2, DIAG must contain positive
+C         entries that serve as implicit (multiplicative) scale factors
+C         for the variables.
+C
+C       MODE is an integer input variable.  If MODE = 1, the variables
+C         will be scaled internally.  If MODE = 2, the scaling is speci-
+C         fied by the input DIAG.  Other values of MODE are equivalent
+C         to MODE = 1.
+C
+C       FACTOR is a positive input variable used in determining the ini-
+C         tial step bound.  This bound is set to the product of FACTOR
+C         and the Euclidean norm of DIAG*X if nonzero, or else to FACTOR
+C         itself.  In most cases FACTOR should lie in the interval
+C         (.1,100.).  100. is a generally recommended value.
+C
+C       NPRINT is an integer input variable that enables controlled
+C         printing of iterates if it is positive.  In this case, FCN is
+C         called with IFLAG = 0 at the beginning of the first iteration
+C         and every NPRINT iterations thereafter and immediately prior
+C         to return, with X and FVEC available for printing. Appropriate
+C         print statements must be added to FCN (see example) and
+C         FVEC should not be altered.  If NPRINT is not positive, no
+C         special calls to FCN with IFLAG = 0 are made.
+C
+C       INFO is an integer output variable.  If the user has terminated
+C         execution, INFO is set to the (negative) value of IFLAG.  See
+C         description of FCN and JAC. Otherwise, INFO is set as follows.
+C
+C         INFO = 0  improper input parameters.
+C
+C         INFO = 1  both actual and predicted relative reductions in the
+C                   sum of squares are at most FTOL.
+C
+C         INFO = 2  relative error between two consecutive iterates is
+C                   at most XTOL.
+C
+C         INFO = 3  conditions for INFO = 1 and INFO = 2 both hold.
+C
+C         INFO = 4  the cosine of the angle between FVEC and any column
+C                   of the Jacobian is at most GTOL in absolute value.
+C
+C         INFO = 5  number of calls to FCN for function evaluation
+C                   has reached MAXFEV.
+C
+C         INFO = 6  FTOL is too small.  No further reduction in the sum
+C                   of squares is possible.
+C
+C         INFO = 7  XTOL is too small.  No further improvement in the
+C                   approximate solution X is possible.
+C
+C         INFO = 8  GTOL is too small.  FVEC is orthogonal to the
+C                   columns of the Jacobian to machine precision.
+C
+C         Sections 4 and 5 contain more details about INFO.
+C
+C       NFEV is an integer output variable set to the number of calls to
+C         FCN for function evaluation.
+C
+C       NJEV is an integer output variable set to the number of
+C         evaluations of the full Jacobian.  If IOPT=2, only one call to
+C         FCN is required for each evaluation of the full Jacobian.
+C         If IOPT=3, the M calls to FCN are required.
+C         If IOPT=1, then NJEV is set to zero.
+C
+C       IPVT is an integer output array of length N.  IPVT defines a
+C         permutation matrix P such that JAC*P = Q*R, where JAC is the
+C         final calculated Jacobian, Q is orthogonal (not stored), and R
+C         is upper triangular with diagonal elements of nonincreasing
+C         magnitude.  Column J of P is column IPVT(J) of the identity
+C         matrix.
+C
+C       QTF is an output array of length N which contains the first N
+C         elements of the vector (Q transpose)*FVEC.
+C
+C       WA1, WA2, and WA3 are work arrays of length N.
+C
+C       WA4 is a work array of length M.
+C
+C
+C 4. Successful Completion.
+C
+C       The accuracy of SNLS1 is controlled by the convergence parame-
+C       ters FTOL, XTOL, and GTOL.  These parameters are used in tests
+C       which make three types of comparisons between the approximation
+C       X and a solution XSOL.  SNLS1 terminates when any of the tests
+C       is satisfied.  If any of the convergence parameters is less than
+C       the machine precision (as defined by the function R1MACH(4)),
+C       then SNLS1 only attempts to satisfy the test defined by the
+C       machine precision.  Further progress is not usually possible.
+C
+C       The tests assume that the functions are reasonably well behaved,
+C       and, if the Jacobian is supplied by the user, that the functions
+C       and the Jacobian are coded consistently.  If these conditions
+C       are not satisfied, then SNLS1 may incorrectly indicate conver-
+C       gence.  If the Jacobian is coded correctly or IOPT=1,
+C       then the validity of the answer can be checked, for example, by
+C       rerunning SNLS1 with tighter tolerances.
+C
+C       First Convergence Test.  If ENORM(Z) denotes the Euclidean norm
+C         of a vector Z, then this test attempts to guarantee that
+C
+C               ENORM(FVEC) .LE. (1+FTOL)*ENORM(FVECS),
+C
+C         where FVECS denotes the functions evaluated at XSOL.  If this
+C         condition is satisfied with FTOL = 10**(-K), then the final
+C         residual norm ENORM(FVEC) has K significant decimal digits and
+C         INFO is set to 1 (or to 3 if the second test is also satis-
+C         fied).  Unless high precision solutions are required, the
+C         recommended value for FTOL is the square root of the machine
+C         precision.
+C
+C       Second Convergence Test.  If D is the diagonal matrix whose
+C         entries are defined by the array DIAG, then this test attempts
+C         to guarantee that
+C
+C               ENORM(D*(X-XSOL)) .LE. XTOL*ENORM(D*XSOL).
+C
+C         If this condition is satisfied with XTOL = 10**(-K), then the
+C         larger components of D*X have K significant decimal digits and
+C         INFO is set to 2 (or to 3 if the first test is also satis-
+C         fied).  There is a danger that the smaller components of D*X
+C         may have large relative errors, but if MODE = 1, then the
+C         accuracy of the components of X is usually related to their
+C         sensitivity.  Unless high precision solutions are required,
+C         the recommended value for XTOL is the square root of the
+C         machine precision.
+C
+C       Third Convergence Test.  This test is satisfied when the cosine
+C         of the angle between FVEC and any column of the Jacobian at X
+C         is at most GTOL in absolute value.  There is no clear rela-
+C         tionship between this test and the accuracy of SNLS1, and
+C         furthermore, the test is equally well satisfied at other crit-
+C         ical points, namely maximizers and saddle points.  Therefore,
+C         termination caused by this test (INFO = 4) should be examined
+C         carefully.  The recommended value for GTOL is zero.
+C
+C
+C 5. Unsuccessful Completion.
+C
+C       Unsuccessful termination of SNLS1 can be due to improper input
+C       parameters, arithmetic interrupts, or an excessive number of
+C       function evaluations.
+C
+C       Improper Input Parameters.  INFO is set to 0 if IOPT .LT. 1
+C         or IOPT .GT. 3, or N .LE. 0, or M .LT. N, or for IOPT=1 or 2
+C         LDFJAC .LT. M, or for IOPT=3 LDFJAC .LT. N, or FTOL .LT. 0.E0,
+C         or XTOL .LT. 0.E0, or GTOL .LT. 0.E0, or MAXFEV .LE. 0, or
+C         FACTOR .LE. 0.E0.
+C
+C       Arithmetic Interrupts.  If these interrupts occur in the FCN
+C         subroutine during an early stage of the computation, they may
+C         be caused by an unacceptable choice of X by SNLS1.  In this
+C         case, it may be possible to remedy the situation by rerunning
+C         SNLS1 with a smaller value of FACTOR.
+C
+C       Excessive Number of Function Evaluations.  A reasonable value
+C         for MAXFEV is 100*(N+1) for IOPT=2 or 3 and 200*(N+1) for
+C         IOPT=1.  If the number of calls to FCN reaches MAXFEV, then
+C         this indicates that the routine is converging very slowly
+C         as measured by the progress of FVEC, and INFO is set to 5.
+C         In this case, it may be helpful to restart SNLS1 with MODE
+C         set to 1.
+C
+C
+C 6. Characteristics of the Algorithm.
+C
+C       SNLS1 is a modification of the Levenberg-Marquardt algorithm.
+C       Two of its main characteristics involve the proper use of
+C       implicitly scaled variables (if MODE = 1) and an optimal choice
+C       for the correction.  The use of implicitly scaled variables
+C       achieves scale invariance of SNLS1 and limits the size of the
+C       correction in any direction where the functions are changing
+C       rapidly.  The optimal choice of the correction guarantees (under
+C       reasonable conditions) global convergence from starting points
+C       far from the solution and a fast rate of convergence for
+C       problems with small residuals.
+C
+C       Timing.  The time required by SNLS1 to solve a given problem
+C         depends on M and N, the behavior of the functions, the accu-
+C         racy requested, and the starting point.  The number of arith-
+C         metic operations needed by SNLS1 is about N**3 to process each
+C         evaluation of the functions (call to FCN) and to process each
+C         evaluation of the Jacobian it takes M*N**2 for IOPT=2 (one
+C         call to FCN), M*N**2 for IOPT=1 (N calls to FCN) and
+C         1.5*M*N**2 for IOPT=3 (M calls to FCN).  Unless FCN
+C         can be evaluated quickly, the timing of SNLS1 will be
+C         strongly influenced by the time spent in FCN.
+C
+C       Storage.  SNLS1 requires (M*N + 2*M + 6*N) for IOPT=1 or 2 and
+C         (N**2 + 2*M + 6*N) for IOPT=3 single precision storage
+C         locations and N integer storage locations, in addition to
+C         the storage required by the program.  There are no internally
+C         declared storage arrays.
+C
+C *Long Description:
+C
+C 7. Example.
+C
+C       The problem is to determine the values of X(1), X(2), and X(3)
+C       which provide the best fit (in the least squares sense) of
+C
+C             X(1) + U(I)/(V(I)*X(2) + W(I)*X(3)),  I = 1, 15
+C
+C       to the data
+C
+C             Y = (0.14,0.18,0.22,0.25,0.29,0.32,0.35,0.39,
+C                  0.37,0.58,0.73,0.96,1.34,2.10,4.39),
+C
+C       where U(I) = I, V(I) = 16 - I, and W(I) = MIN(U(I),V(I)).  The
+C       I-th component of FVEC is thus defined by
+C
+C             Y(I) - (X(1) + U(I)/(V(I)*X(2) + W(I)*X(3))).
+C
+C       **********
+C
+C       PROGRAM TEST
+C C
+C C     Driver for SNLS1 example.
+C C
+C       INTEGER J,IOPT,M,N,LDFJAC,MAXFEV,MODE,NPRINT,INFO,NFEV,NJEV,
+C      *        NWRITE
+C       INTEGER IPVT(3)
+C       REAL FTOL,XTOL,GTOL,FACTOR,FNORM,EPSFCN
+C       REAL X(3),FVEC(15),FJAC(15,3),DIAG(3),QTF(3),
+C      *     WA1(3),WA2(3),WA3(3),WA4(15)
+C       REAL ENORM,R1MACH
+C       EXTERNAL FCN
+C       DATA NWRITE /6/
+C C
+C       IOPT = 1
+C       M = 15
+C       N = 3
+C C
+C C     The following starting values provide a rough fit.
+C C
+C       X(1) = 1.E0
+C       X(2) = 1.E0
+C       X(3) = 1.E0
+C C
+C       LDFJAC = 15
+C C
+C C     Set FTOL and XTOL to the square root of the machine precision
+C C     and GTOL to zero.  Unless high precision solutions are
+C C     required, these are the recommended settings.
+C C
+C       FTOL = SQRT(R1MACH(4))
+C       XTOL = SQRT(R1MACH(4))
+C       GTOL = 0.E0
+C C
+C       MAXFEV = 400
+C       EPSFCN = 0.0
+C       MODE = 1
+C       FACTOR = 1.E2
+C       NPRINT = 0
+C C
+C       CALL SNLS1(FCN,IOPT,M,N,X,FVEC,FJAC,LDFJAC,FTOL,XTOL,
+C      *           GTOL,MAXFEV,EPSFCN,DIAG,MODE,FACTOR,NPRINT,
+C      *           INFO,NFEV,NJEV,IPVT,QTF,WA1,WA2,WA3,WA4)
+C       FNORM = ENORM(M,FVEC)
+C       WRITE (NWRITE,1000) FNORM,NFEV,NJEV,INFO,(X(J),J=1,N)
+C       STOP
+C  1000 FORMAT (5X,' FINAL L2 NORM OF THE RESIDUALS',E15.7 //
+C      *        5X,' NUMBER OF FUNCTION EVALUATIONS',I10 //
+C      *        5X,' NUMBER OF JACOBIAN EVALUATIONS',I10 //
+C      *        5X,' EXIT PARAMETER',16X,I10 //
+C      *        5X,' FINAL APPROXIMATE SOLUTION' // 5X,3E15.7)
+C       END
+C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,DUM,IDUM)
+C C     This is the form of the FCN routine if IOPT=1,
+C C     that is, if the user does not calculate the Jacobian.
+C       INTEGER M,N,IFLAG
+C       REAL X(N),FVEC(M)
+C       INTEGER I
+C       REAL TMP1,TMP2,TMP3,TMP4
+C       REAL Y(15)
+C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
+C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
+C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
+C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
+C C
+C       IF (IFLAG .NE. 0) GO TO 5
+C C
+C C     Insert print statements here when NPRINT is positive.
+C C
+C       RETURN
+C     5 CONTINUE
+C       DO 10 I = 1, M
+C          TMP1 = I
+C          TMP2 = 16 - I
+C          TMP3 = TMP1
+C          IF (I .GT. 8) TMP3 = TMP2
+C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
+C    10    CONTINUE
+C       RETURN
+C       END
+C
+C
+C       Results obtained with different compilers or machines
+C       may be slightly different.
+C
+C       FINAL L2 NORM OF THE RESIDUALS  0.9063596E-01
+C
+C       NUMBER OF FUNCTION EVALUATIONS        25
+C
+C       NUMBER OF JACOBIAN EVALUATIONS         0
+C
+C       EXIT PARAMETER                         1
+C
+C       FINAL APPROXIMATE SOLUTION
+C
+C        0.8241058E-01  0.1133037E+01  0.2343695E+01
+C
+C
+C       For IOPT=2, FCN would be modified as follows to also
+C       calculate the full Jacobian when IFLAG=2.
+C
+C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
+C C
+C C     This is the form of the FCN routine if IOPT=2,
+C C     that is, if the user calculates the full Jacobian.
+C C
+C       INTEGER LDFJAC,M,N,IFLAG
+C       REAL X(N),FVEC(M)
+C       REAL FJAC(LDFJAC,N)
+C       INTEGER I
+C       REAL TMP1,TMP2,TMP3,TMP4
+C       REAL Y(15)
+C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
+C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
+C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
+C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
+C C
+C       IF (IFLAG .NE. 0) GO TO 5
+C C
+C C     Insert print statements here when NPRINT is positive.
+C C
+C       RETURN
+C     5 CONTINUE
+C       IF(IFLAG.NE.1) GO TO 20
+C       DO 10 I = 1, M
+C          TMP1 = I
+C          TMP2 = 16 - I
+C          TMP3 = TMP1
+C          IF (I .GT. 8) TMP3 = TMP2
+C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
+C    10    CONTINUE
+C       RETURN
+C C
+C C     Below, calculate the full Jacobian.
+C C
+C    20    CONTINUE
+C C
+C       DO 30 I = 1, M
+C          TMP1 = I
+C          TMP2 = 16 - I
+C          TMP3 = TMP1
+C          IF (I .GT. 8) TMP3 = TMP2
+C          TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
+C          FJAC(I,1) = -1.E0
+C          FJAC(I,2) = TMP1*TMP2/TMP4
+C          FJAC(I,3) = TMP1*TMP3/TMP4
+C    30    CONTINUE
+C       RETURN
+C       END
+C
+C
+C       For IOPT = 3, FJAC would be dimensioned as FJAC(3,3),
+C         LDFJAC would be set to 3, and FCN would be written as
+C         follows to calculate a row of the Jacobian when IFLAG=3.
+C
+C       SUBROUTINE FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
+C C     This is the form of the FCN routine if IOPT=3,
+C C     that is, if the user calculates the Jacobian row by row.
+C       INTEGER M,N,IFLAG
+C       REAL X(N),FVEC(M)
+C       REAL FJAC(N)
+C       INTEGER I
+C       REAL TMP1,TMP2,TMP3,TMP4
+C       REAL Y(15)
+C       DATA Y(1),Y(2),Y(3),Y(4),Y(5),Y(6),Y(7),Y(8),
+C      *     Y(9),Y(10),Y(11),Y(12),Y(13),Y(14),Y(15)
+C      *     /1.4E-1,1.8E-1,2.2E-1,2.5E-1,2.9E-1,3.2E-1,3.5E-1,3.9E-1,
+C      *      3.7E-1,5.8E-1,7.3E-1,9.6E-1,1.34E0,2.1E0,4.39E0/
+C C
+C       IF (IFLAG .NE. 0) GO TO 5
+C C
+C C     Insert print statements here when NPRINT is positive.
+C C
+C       RETURN
+C     5 CONTINUE
+C       IF( IFLAG.NE.1) GO TO 20
+C       DO 10 I = 1, M
+C          TMP1 = I
+C          TMP2 = 16 - I
+C          TMP3 = TMP1
+C          IF (I .GT. 8) TMP3 = TMP2
+C          FVEC(I) = Y(I) - (X(1) + TMP1/(X(2)*TMP2 + X(3)*TMP3))
+C    10    CONTINUE
+C       RETURN
+C C
+C C     Below, calculate the LDFJAC-th row of the Jacobian.
+C C
+C    20 CONTINUE
+C
+C       I = LDFJAC
+C          TMP1 = I
+C          TMP2 = 16 - I
+C          TMP3 = TMP1
+C          IF (I .GT. 8) TMP3 = TMP2
+C          TMP4 = (X(2)*TMP2 + X(3)*TMP3)**2
+C          FJAC(1) = -1.E0
+C          FJAC(2) = TMP1*TMP2/TMP4
+C          FJAC(3) = TMP1*TMP3/TMP4
+C       RETURN
+C       END
+C
+C***REFERENCES  Jorge J. More, The Levenberg-Marquardt algorithm:
+C                 implementation and theory.  In Numerical Analysis
+C                 Proceedings (Dundee, June 28 - July 1, 1977, G. A.
+C                 Watson, Editor), Lecture Notes in Mathematics 630,
+C                 Springer-Verlag, 1978.
+C***ROUTINES CALLED  CHKDER, ENORM, FDJAC3, LMPAR, QRFAC, R1MACH,
+C                    RWUPDT, XERMSG
+C***REVISION HISTORY  (YYMMDD)
+C   800301  DATE WRITTEN
+C   890531  Changed all specific intrinsics to generic.  (WRB)
+C   890531  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900315  CALLs to XERROR changed to CALLs to XERMSG.  (THJ)
+C   900510  Convert XERRWV calls to XERMSG calls.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  SNLS1
+      INTEGER IOPT,M,N,LDFJAC,MAXFEV,MODE,NPRINT,INFO,NFEV,NJEV
+      INTEGER IJUNK,NROW,IPVT(*)
+      REAL FTOL,XTOL,GTOL,FACTOR,EPSFCN
+      REAL X(*),FVEC(*),FJAC(LDFJAC,*),DIAG(*),QTF(*),WA1(*),WA2(*),
+     1     WA3(*),WA4(*)
+      LOGICAL SING
+      EXTERNAL FCN
+      INTEGER I,IFLAG,ITER,J,L,MODECH
+      REAL ACTRED,DELTA,DIRDER,EPSMCH,FNORM,FNORM1,GNORM,ONE,PAR,
+     1     PNORM,PRERED,P1,P5,P25,P75,P0001,RATIO,SUM,TEMP,TEMP1,
+     2     TEMP2,XNORM,ZERO
+      REAL R1MACH,ENORM,ERR,CHKLIM
+      CHARACTER*8 XERN1
+      CHARACTER*16 XERN3
+C
+      SAVE CHKLIM, ONE, P1, P5, P25, P75, P0001, ZERO
+      DATA CHKLIM/.1E0/
+      DATA ONE,P1,P5,P25,P75,P0001,ZERO
+     1     /1.0E0,1.0E-1,5.0E-1,2.5E-1,7.5E-1,1.0E-4,0.0E0/
+C
+C***FIRST EXECUTABLE STATEMENT  SNLS1
+      EPSMCH = R1MACH(4)
+C
+      INFO = 0
+      IFLAG = 0
+      NFEV = 0
+      NJEV = 0
+C
+C     CHECK THE INPUT PARAMETERS FOR ERRORS.
+C
+      IF (IOPT .LT. 1 .OR. IOPT .GT. 3 .OR. N .LE. 0 .OR.
+     1    M .LT. N .OR. LDFJAC .LT. N .OR. FTOL .LT. ZERO
+     2    .OR. XTOL .LT. ZERO .OR. GTOL .LT. ZERO
+     3    .OR. MAXFEV .LE. 0 .OR. FACTOR .LE. ZERO) GO TO 300
+      IF (IOPT .LT. 3 .AND. LDFJAC .LT. M) GO TO 300
+      IF (MODE .NE. 2) GO TO 20
+      DO 10 J = 1, N
+         IF (DIAG(J) .LE. ZERO) GO TO 300
+   10    CONTINUE
+   20 CONTINUE
+C
+C     EVALUATE THE FUNCTION AT THE STARTING POINT
+C     AND CALCULATE ITS NORM.
+C
+      IFLAG = 1
+      IJUNK = 1
+      CALL FCN(IFLAG,M,N,X,FVEC,FJAC,IJUNK)
+      NFEV = 1
+      IF (IFLAG .LT. 0) GO TO 300
+      FNORM = ENORM(M,FVEC)
+C
+C     INITIALIZE LEVENBERG-MARQUARDT PARAMETER AND ITERATION COUNTER.
+C
+      PAR = ZERO
+      ITER = 1
+C
+C     BEGINNING OF THE OUTER LOOP.
+C
+   30 CONTINUE
+C
+C        IF REQUESTED, CALL FCN TO ENABLE PRINTING OF ITERATES.
+C
+         IF (NPRINT .LE. 0) GO TO 40
+         IFLAG = 0
+         IF (MOD(ITER-1,NPRINT) .EQ. 0)
+     1      CALL FCN(IFLAG,M,N,X,FVEC,FJAC,IJUNK)
+         IF (IFLAG .LT. 0) GO TO 300
+   40    CONTINUE
+C
+C        CALCULATE THE JACOBIAN MATRIX.
+C
+      IF (IOPT .EQ. 3) GO TO 475
+C
+C     STORE THE FULL JACOBIAN USING M*N STORAGE
+C
+      IF (IOPT .EQ. 1) GO TO 410
+C
+C     THE USER SUPPLIES THE JACOBIAN
+C
+         IFLAG = 2
+         CALL FCN(IFLAG,M,N,X,FVEC,FJAC,LDFJAC)
+         NJEV = NJEV + 1
+C
+C             ON THE FIRST ITERATION, CHECK THE USER SUPPLIED JACOBIAN
+C
+         IF (ITER .LE. 1) THEN
+            IF (IFLAG .LT. 0) GO TO 300
+C
+C           GET THE INCREMENTED X-VALUES INTO WA1(*).
+C
+            MODECH = 1
+            CALL CHKDER(M,N,X,FVEC,FJAC,LDFJAC,WA1,WA4,MODECH,ERR)
+C
+C           EVALUATE FUNCTION AT INCREMENTED VALUE AND PUT IN WA4(*).
+C
+            IFLAG = 1
+            CALL FCN(IFLAG,M,N,WA1,WA4,FJAC,LDFJAC)
+            NFEV = NFEV + 1
+            IF(IFLAG .LT. 0) GO TO 300
+            DO 350 I = 1, M
+               MODECH = 2
+               CALL CHKDER(1,N,X,FVEC(I),FJAC(I,1),LDFJAC,WA1,
+     1              WA4(I),MODECH,ERR)
+               IF (ERR .LT. CHKLIM) THEN
+                  WRITE (XERN1, '(I8)') I
+                  WRITE (XERN3, '(1PE15.6)') ERR
+                  CALL XERMSG ('SLATEC', 'SNLS1', 'DERIVATIVE OF ' //
+     *               'FUNCTION ' // XERN1 // ' MAY BE WRONG, ERR = ' //
+     *               XERN3 // ' TOO CLOSE TO 0.', 7, 0)
+               ENDIF
+  350       CONTINUE
+         ENDIF
+C
+         GO TO 420
+C
+C     THE CODE APPROXIMATES THE JACOBIAN
+C
+410      IFLAG = 1
+         CALL FDJAC3(FCN,M,N,X,FVEC,FJAC,LDFJAC,IFLAG,EPSFCN,WA4)
+         NFEV = NFEV + N
+  420    IF (IFLAG .LT. 0) GO TO 300
+C
+C        COMPUTE THE QR FACTORIZATION OF THE JACOBIAN.
+C
+         CALL QRFAC(M,N,FJAC,LDFJAC,.TRUE.,IPVT,N,WA1,WA2,WA3)
+C
+C        FORM (Q TRANSPOSE)*FVEC AND STORE THE FIRST N COMPONENTS IN
+C        QTF.
+C
+         DO 430 I = 1, M
+            WA4(I) = FVEC(I)
+  430         CONTINUE
+         DO 470 J = 1, N
+            IF (FJAC(J,J) .EQ. ZERO) GO TO 460
+            SUM = ZERO
+            DO 440 I = J, M
+               SUM = SUM + FJAC(I,J)*WA4(I)
+  440          CONTINUE
+            TEMP = -SUM/FJAC(J,J)
+            DO 450 I = J, M
+               WA4(I) = WA4(I) + FJAC(I,J)*TEMP
+  450          CONTINUE
+  460       CONTINUE
+            FJAC(J,J) = WA1(J)
+            QTF(J) = WA4(J)
+  470       CONTINUE
+         GO TO 560
+C
+C        ACCUMULATE THE JACOBIAN BY ROWS IN ORDER TO SAVE STORAGE.
+C        COMPUTE THE QR FACTORIZATION OF THE JACOBIAN MATRIX
+C        CALCULATED ONE ROW AT A TIME, WHILE SIMULTANEOUSLY
+C        FORMING (Q TRANSPOSE)*FVEC AND STORING THE FIRST
+C        N COMPONENTS IN QTF.
+C
+  475    DO 490 J = 1, N
+            QTF(J) = ZERO
+            DO 480 I = 1, N
+               FJAC(I,J) = ZERO
+  480          CONTINUE
+  490        CONTINUE
+         DO 500 I = 1, M
+            NROW = I
+            IFLAG = 3
+            CALL FCN(IFLAG,M,N,X,FVEC,WA3,NROW)
+            IF (IFLAG .LT. 0) GO TO 300
+C
+C            ON THE FIRST ITERATION, CHECK THE USER SUPPLIED JACOBIAN.
+C
+            IF(ITER .GT. 1) GO TO 498
+C
+C            GET THE INCREMENTED X-VALUES INTO WA1(*).
+C
+            MODECH = 1
+            CALL CHKDER(M,N,X,FVEC,FJAC,LDFJAC,WA1,WA4,MODECH,ERR)
+C
+C            EVALUATE AT INCREMENTED VALUES, IF NOT ALREADY EVALUATED.
+C
+            IF(I .NE. 1) GO TO 495
+C
+C            EVALUATE FUNCTION AT INCREMENTED VALUE AND PUT INTO WA4(*).
+C
+            IFLAG = 1
+            CALL FCN(IFLAG,M,N,WA1,WA4,FJAC,NROW)
+            NFEV = NFEV + 1
+            IF(IFLAG .LT. 0) GO TO 300
+495         CONTINUE
+            MODECH = 2
+            CALL CHKDER(1,N,X,FVEC(I),WA3,1,WA1,WA4(I),MODECH,ERR)
+            IF (ERR .LT. CHKLIM) THEN
+               WRITE (XERN1, '(I8)') I
+               WRITE (XERN3, '(1PE15.6)') ERR
+               CALL XERMSG ('SLATEC', 'SNLS1', 'DERIVATIVE OF FUNCTION '
+     *            // XERN1 // ' MAY BE WRONG, ERR = ' // XERN3 //
+     *            ' TOO CLOSE TO 0.', 7, 0)
+            ENDIF
+498         CONTINUE
+C
+            TEMP = FVEC(I)
+            CALL RWUPDT(N,FJAC,LDFJAC,WA3,QTF,TEMP,WA1,WA2)
+  500       CONTINUE
+         NJEV = NJEV + 1
+C
+C        IF THE JACOBIAN IS RANK DEFICIENT, CALL QRFAC TO
+C        REORDER ITS COLUMNS AND UPDATE THE COMPONENTS OF QTF.
+C
+         SING = .FALSE.
+         DO 510 J = 1, N
+            IF (FJAC(J,J) .EQ. ZERO) SING = .TRUE.
+            IPVT(J) = J
+            WA2(J) = ENORM(J,FJAC(1,J))
+  510       CONTINUE
+         IF (.NOT.SING) GO TO 560
+         CALL QRFAC(N,N,FJAC,LDFJAC,.TRUE.,IPVT,N,WA1,WA2,WA3)
+         DO 550 J = 1, N
+            IF (FJAC(J,J) .EQ. ZERO) GO TO 540
+            SUM = ZERO
+            DO 520 I = J, N
+               SUM = SUM + FJAC(I,J)*QTF(I)
+  520         CONTINUE
+            TEMP = -SUM/FJAC(J,J)
+            DO 530 I = J, N
+               QTF(I) = QTF(I) + FJAC(I,J)*TEMP
+  530          CONTINUE
+  540       CONTINUE
+            FJAC(J,J) = WA1(J)
+  550       CONTINUE
+  560    CONTINUE
+C
+C        ON THE FIRST ITERATION AND IF MODE IS 1, SCALE ACCORDING
+C        TO THE NORMS OF THE COLUMNS OF THE INITIAL JACOBIAN.
+C
+         IF (ITER .NE. 1) GO TO 80
+         IF (MODE .EQ. 2) GO TO 60
+         DO 50 J = 1, N
+            DIAG(J) = WA2(J)
+            IF (WA2(J) .EQ. ZERO) DIAG(J) = ONE
+   50       CONTINUE
+   60    CONTINUE
+C
+C        ON THE FIRST ITERATION, CALCULATE THE NORM OF THE SCALED X
+C        AND INITIALIZE THE STEP BOUND DELTA.
+C
+         DO 70 J = 1, N
+            WA3(J) = DIAG(J)*X(J)
+   70       CONTINUE
+         XNORM = ENORM(N,WA3)
+         DELTA = FACTOR*XNORM
+         IF (DELTA .EQ. ZERO) DELTA = FACTOR
+   80    CONTINUE
+C
+C        COMPUTE THE NORM OF THE SCALED GRADIENT.
+C
+         GNORM = ZERO
+         IF (FNORM .EQ. ZERO) GO TO 170
+         DO 160 J = 1, N
+            L = IPVT(J)
+            IF (WA2(L) .EQ. ZERO) GO TO 150
+            SUM = ZERO
+            DO 140 I = 1, J
+               SUM = SUM + FJAC(I,J)*(QTF(I)/FNORM)
+  140          CONTINUE
+            GNORM = MAX(GNORM,ABS(SUM/WA2(L)))
+  150       CONTINUE
+  160       CONTINUE
+  170    CONTINUE
+C
+C        TEST FOR CONVERGENCE OF THE GRADIENT NORM.
+C
+         IF (GNORM .LE. GTOL) INFO = 4
+         IF (INFO .NE. 0) GO TO 300
+C
+C        RESCALE IF NECESSARY.
+C
+         IF (MODE .EQ. 2) GO TO 190
+         DO 180 J = 1, N
+            DIAG(J) = MAX(DIAG(J),WA2(J))
+  180       CONTINUE
+  190    CONTINUE
+C
+C        BEGINNING OF THE INNER LOOP.
+C
+  200    CONTINUE
+C
+C           DETERMINE THE LEVENBERG-MARQUARDT PARAMETER.
+C
+            CALL LMPAR(N,FJAC,LDFJAC,IPVT,DIAG,QTF,DELTA,PAR,WA1,WA2,
+     1                 WA3,WA4)
+C
+C           STORE THE DIRECTION P AND X + P. CALCULATE THE NORM OF P.
+C
+            DO 210 J = 1, N
+               WA1(J) = -WA1(J)
+               WA2(J) = X(J) + WA1(J)
+               WA3(J) = DIAG(J)*WA1(J)
+  210          CONTINUE
+            PNORM = ENORM(N,WA3)
+C
+C           ON THE FIRST ITERATION, ADJUST THE INITIAL STEP BOUND.
+C
+            IF (ITER .EQ. 1) DELTA = MIN(DELTA,PNORM)
+C
+C           EVALUATE THE FUNCTION AT X + P AND CALCULATE ITS NORM.
+C
+            IFLAG = 1
+            CALL FCN(IFLAG,M,N,WA2,WA4,FJAC,IJUNK)
+            NFEV = NFEV + 1
+            IF (IFLAG .LT. 0) GO TO 300
+            FNORM1 = ENORM(M,WA4)
+C
+C           COMPUTE THE SCALED ACTUAL REDUCTION.
+C
+            ACTRED = -ONE
+            IF (P1*FNORM1 .LT. FNORM) ACTRED = ONE - (FNORM1/FNORM)**2
+C
+C           COMPUTE THE SCALED PREDICTED REDUCTION AND
+C           THE SCALED DIRECTIONAL DERIVATIVE.
+C
+            DO 230 J = 1, N
+               WA3(J) = ZERO
+               L = IPVT(J)
+               TEMP = WA1(L)
+               DO 220 I = 1, J
+                  WA3(I) = WA3(I) + FJAC(I,J)*TEMP
+  220             CONTINUE
+  230          CONTINUE
+            TEMP1 = ENORM(N,WA3)/FNORM
+            TEMP2 = (SQRT(PAR)*PNORM)/FNORM
+            PRERED = TEMP1**2 + TEMP2**2/P5
+            DIRDER = -(TEMP1**2 + TEMP2**2)
+C
+C           COMPUTE THE RATIO OF THE ACTUAL TO THE PREDICTED
+C           REDUCTION.
+C
+            RATIO = ZERO
+            IF (PRERED .NE. ZERO) RATIO = ACTRED/PRERED
+C
+C           UPDATE THE STEP BOUND.
+C
+            IF (RATIO .GT. P25) GO TO 240
+               IF (ACTRED .GE. ZERO) TEMP = P5
+               IF (ACTRED .LT. ZERO)
+     1            TEMP = P5*DIRDER/(DIRDER + P5*ACTRED)
+               IF (P1*FNORM1 .GE. FNORM .OR. TEMP .LT. P1) TEMP = P1
+               DELTA = TEMP*MIN(DELTA,PNORM/P1)
+               PAR = PAR/TEMP
+               GO TO 260
+  240       CONTINUE
+               IF (PAR .NE. ZERO .AND. RATIO .LT. P75) GO TO 250
+               DELTA = PNORM/P5
+               PAR = P5*PAR
+  250          CONTINUE
+  260       CONTINUE
+C
+C           TEST FOR SUCCESSFUL ITERATION.
+C
+            IF (RATIO .LT. P0001) GO TO 290
+C
+C           SUCCESSFUL ITERATION. UPDATE X, FVEC, AND THEIR NORMS.
+C
+            DO 270 J = 1, N
+               X(J) = WA2(J)
+               WA2(J) = DIAG(J)*X(J)
+  270          CONTINUE
+            DO 280 I = 1, M
+               FVEC(I) = WA4(I)
+  280          CONTINUE
+            XNORM = ENORM(N,WA2)
+            FNORM = FNORM1
+            ITER = ITER + 1
+  290       CONTINUE
+C
+C           TESTS FOR CONVERGENCE.
+C
+            IF (ABS(ACTRED) .LE. FTOL .AND. PRERED .LE. FTOL
+     1          .AND. P5*RATIO .LE. ONE) INFO = 1
+            IF (DELTA .LE. XTOL*XNORM) INFO = 2
+            IF (ABS(ACTRED) .LE. FTOL .AND. PRERED .LE. FTOL
+     1          .AND. P5*RATIO .LE. ONE .AND. INFO .EQ. 2) INFO = 3
+            IF (INFO .NE. 0) GO TO 300
+C
+C           TESTS FOR TERMINATION AND STRINGENT TOLERANCES.
+C
+            IF (NFEV .GE. MAXFEV) INFO = 5
+            IF (ABS(ACTRED) .LE. EPSMCH .AND. PRERED .LE. EPSMCH
+     1          .AND. P5*RATIO .LE. ONE) INFO = 6
+            IF (DELTA .LE. EPSMCH*XNORM) INFO = 7
+            IF (GNORM .LE. EPSMCH) INFO = 8
+            IF (INFO .NE. 0) GO TO 300
+C
+C           END OF THE INNER LOOP. REPEAT IF ITERATION UNSUCCESSFUL.
+C
+            IF (RATIO .LT. P0001) GO TO 200
+C
+C        END OF THE OUTER LOOP.
+C
+         GO TO 30
+  300 CONTINUE
+C
+C     TERMINATION, EITHER NORMAL OR USER IMPOSED.
+C
+      IF (IFLAG .LT. 0) INFO = IFLAG
+      IFLAG = 0
+      IF (NPRINT .GT. 0) CALL FCN(IFLAG,M,N,X,FVEC,FJAC,IJUNK)
+      IF (INFO .LT. 0) CALL XERMSG ('SLATEC', 'SNLS1',
+     +   'EXECUTION TERMINATED BECAUSE USER SET IFLAG NEGATIVE.', 1, 1)
+      IF (INFO .EQ. 0) CALL XERMSG ('SLATEC', 'SNLS1',
+     +   'INVALID INPUT PARAMETER.', 2, 1)
+      IF (INFO .EQ. 4) CALL XERMSG ('SLATEC', 'SNLS1',
+     +   'THIRD CONVERGENCE CONDITION, CHECK RESULTS BEFORE ACCEPTING.',
+     +   1, 1)
+      IF (INFO .EQ. 5) CALL XERMSG ('SLATEC', 'SNLS1',
+     +   'TOO MANY FUNCTION EVALUATIONS.', 9, 1)
+      IF (INFO .GE. 6) CALL XERMSG ('SLATEC', 'SNLS1',
+     +   'TOLERANCES TOO SMALL, NO FURTHER IMPROVEMENT POSSIBLE.', 3, 1)
+      RETURN
+C
+C     LAST CARD OF SUBROUTINE SNLS1.
+C
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/tql2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/tql2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,203 @@
+*DECK TQL2
+      SUBROUTINE TQL2 (NM, N, D, E, Z, IERR)
+C***BEGIN PROLOGUE  TQL2
+C***PURPOSE  Compute the eigenvalues and eigenvectors of symmetric
+C            tridiagonal matrix.
+C***LIBRARY   SLATEC (EISPACK)
+C***CATEGORY  D4A5, D4C2A
+C***TYPE      SINGLE PRECISION (TQL2-S)
+C***KEYWORDS  EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR  Smith, B. T., et al.
+C***DESCRIPTION
+C
+C     This subroutine is a translation of the ALGOL procedure TQL2,
+C     NUM. MATH. 11, 293-306(1968) by Bowdler, Martin, Reinsch, and
+C     Wilkinson.
+C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 227-240(1971).
+C
+C     This subroutine finds the eigenvalues and eigenvectors
+C     of a SYMMETRIC TRIDIAGONAL matrix by the QL method.
+C     The eigenvectors of a FULL SYMMETRIC matrix can also
+C     be found if  TRED2  has been used to reduce this
+C     full matrix to tridiagonal form.
+C
+C     On Input
+C
+C        NM must be set to the row dimension of the two-dimensional
+C          array parameter, Z, as declared in the calling program
+C          dimension statement.  NM is an INTEGER variable.
+C
+C        N is the order of the matrix.  N is an INTEGER variable.
+C          N must be less than or equal to NM.
+C
+C        D contains the diagonal elements of the symmetric tridiagonal
+C          matrix.  D is a one-dimensional REAL array, dimensioned D(N).
+C
+C        E contains the subdiagonal elements of the symmetric
+C          tridiagonal matrix in its last N-1 positions.  E(1) is
+C          arbitrary.  E is a one-dimensional REAL array, dimensioned
+C          E(N).
+C
+C        Z contains the transformation matrix produced in the
+C          reduction by  TRED2, if performed.  If the eigenvectors
+C          of the tridiagonal matrix are desired, Z must contain
+C          the identity matrix.  Z is a two-dimensional REAL array,
+C          dimensioned Z(NM,N).
+C
+C      On Output
+C
+C        D contains the eigenvalues in ascending order.  If an
+C          error exit is made, the eigenvalues are correct but
+C          unordered for indices 1, 2, ..., IERR-1.
+C
+C        E has been destroyed.
+C
+C        Z contains orthonormal eigenvectors of the symmetric
+C          tridiagonal (or full) matrix.  If an error exit is made,
+C          Z contains the eigenvectors associated with the stored
+C          eigenvalues.
+C
+C        IERR is an INTEGER flag set to
+C          Zero       for normal return,
+C          J          if the J-th eigenvalue has not been
+C                     determined after 30 iterations.
+C
+C     Calls PYTHAG(A,B) for sqrt(A**2 + B**2).
+C
+C     Questions and comments should be directed to B. S. Garbow,
+C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C     ------------------------------------------------------------------
+C
+C***REFERENCES  B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C                 Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C                 system Routines - EISPACK Guide, Springer-Verlag,
+C                 1976.
+C***ROUTINES CALLED  PYTHAG
+C***REVISION HISTORY  (YYMMDD)
+C   760101  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  TQL2
+C
+      INTEGER I,J,K,L,M,N,II,L1,L2,NM,MML,IERR
+      REAL D(*),E(*),Z(NM,*)
+      REAL B,C,C2,C3,DL1,EL1,F,G,H,P,R,S,S2
+      REAL PYTHAG
+C
+C***FIRST EXECUTABLE STATEMENT  TQL2
+      IERR = 0
+      IF (N .EQ. 1) GO TO 1001
+C
+      DO 100 I = 2, N
+  100 E(I-1) = E(I)
+C
+      F = 0.0E0
+      B = 0.0E0
+      E(N) = 0.0E0
+C
+      DO 240 L = 1, N
+         J = 0
+         H = ABS(D(L)) + ABS(E(L))
+         IF (B .LT. H) B = H
+C     .......... LOOK FOR SMALL SUB-DIAGONAL ELEMENT ..........
+         DO 110 M = L, N
+            IF (B + ABS(E(M)) .EQ. B) GO TO 120
+C     .......... E(N) IS ALWAYS ZERO, SO THERE IS NO EXIT
+C                THROUGH THE BOTTOM OF THE LOOP ..........
+  110    CONTINUE
+C
+  120    IF (M .EQ. L) GO TO 220
+  130    IF (J .EQ. 30) GO TO 1000
+         J = J + 1
+C     .......... FORM SHIFT ..........
+         L1 = L + 1
+         L2 = L1 + 1
+         G = D(L)
+         P = (D(L1) - G) / (2.0E0 * E(L))
+         R = PYTHAG(P,1.0E0)
+         D(L) = E(L) / (P + SIGN(R,P))
+         D(L1) = E(L) * (P + SIGN(R,P))
+         DL1 = D(L1)
+         H = G - D(L)
+         IF (L2 .GT. N) GO TO 145
+C
+         DO 140 I = L2, N
+  140    D(I) = D(I) - H
+C
+  145    F = F + H
+C     .......... QL TRANSFORMATION ..........
+         P = D(M)
+         C = 1.0E0
+         C2 = C
+         EL1 = E(L1)
+         S = 0.0E0
+         MML = M - L
+C     .......... FOR I=M-1 STEP -1 UNTIL L DO -- ..........
+         DO 200 II = 1, MML
+            C3 = C2
+            C2 = C
+            S2 = S
+            I = M - II
+            G = C * E(I)
+            H = C * P
+            IF (ABS(P) .LT. ABS(E(I))) GO TO 150
+            C = E(I) / P
+            R = SQRT(C*C+1.0E0)
+            E(I+1) = S * P * R
+            S = C / R
+            C = 1.0E0 / R
+            GO TO 160
+  150       C = P / E(I)
+            R = SQRT(C*C+1.0E0)
+            E(I+1) = S * E(I) * R
+            S = 1.0E0 / R
+            C = C * S
+  160       P = C * D(I) - S * G
+            D(I+1) = H + S * (C * G + S * D(I))
+C     .......... FORM VECTOR ..........
+            DO 180 K = 1, N
+               H = Z(K,I+1)
+               Z(K,I+1) = S * Z(K,I) + C * H
+               Z(K,I) = C * Z(K,I) - S * H
+  180       CONTINUE
+C
+  200    CONTINUE
+C
+         P = -S * S2 * C3 * EL1 * E(L) / DL1
+         E(L) = S * P
+         D(L) = C * P
+         IF (B + ABS(E(L)) .GT. B) GO TO 130
+  220    D(L) = D(L) + F
+  240 CONTINUE
+C     .......... ORDER EIGENVALUES AND EIGENVECTORS ..........
+      DO 300 II = 2, N
+         I = II - 1
+         K = I
+         P = D(I)
+C
+         DO 260 J = II, N
+            IF (D(J) .GE. P) GO TO 260
+            K = J
+            P = D(J)
+  260    CONTINUE
+C
+         IF (K .EQ. I) GO TO 300
+         D(K) = D(I)
+         D(I) = P
+C
+         DO 280 J = 1, N
+            P = Z(J,I)
+            Z(J,I) = Z(J,K)
+            Z(J,K) = P
+  280    CONTINUE
+C
+  300 CONTINUE
+C
+      GO TO 1001
+C     .......... SET ERROR -- NO CONVERGENCE TO AN
+C                EIGENVALUE AFTER 30 ITERATIONS ..........
+ 1000 IERR = L
+ 1001 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/tqlrat.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/tqlrat.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,165 @@
+*DECK TQLRAT
+      SUBROUTINE TQLRAT (N, D, E2, IERR)
+C***BEGIN PROLOGUE  TQLRAT
+C***PURPOSE  Compute the eigenvalues of symmetric tridiagonal matrix
+C            using a rational variant of the QL method.
+C***LIBRARY   SLATEC (EISPACK)
+C***CATEGORY  D4A5, D4C2A
+C***TYPE      SINGLE PRECISION (TQLRAT-S)
+C***KEYWORDS  EIGENVALUES OF A SYMMETRIC TRIDIAGONAL MATRIX, EISPACK,
+C             QL METHOD
+C***AUTHOR  Smith, B. T., et al.
+C***DESCRIPTION
+C
+C     This subroutine is a translation of the ALGOL procedure TQLRAT.
+C
+C     This subroutine finds the eigenvalues of a SYMMETRIC
+C     TRIDIAGONAL matrix by the rational QL method.
+C
+C     On Input
+C
+C        N is the order of the matrix.  N is an INTEGER variable.
+C
+C        D contains the diagonal elements of the symmetric tridiagonal
+C          matrix.  D is a one-dimensional REAL array, dimensioned D(N).
+C
+C        E2 contains the squares of the subdiagonal elements of the
+C          symmetric tridiagonal matrix in its last N-1 positions.
+C          E2(1) is arbitrary.  E2 is a one-dimensional REAL array,
+C          dimensioned E2(N).
+C
+C      On Output
+C
+C        D contains the eigenvalues in ascending order.  If an
+C          error exit is made, the eigenvalues are correct and
+C          ordered for indices 1, 2, ..., IERR-1, but may not be
+C          the smallest eigenvalues.
+C
+C        E2 has been destroyed.
+C
+C        IERR is an INTEGER flag set to
+C          Zero       for normal return,
+C          J          if the J-th eigenvalue has not been
+C                     determined after 30 iterations.
+C
+C     Calls PYTHAG(A,B) for sqrt(A**2 + B**2).
+C
+C     Questions and comments should be directed to B. S. Garbow,
+C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C     ------------------------------------------------------------------
+C
+C***REFERENCES  B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C                 Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C                 system Routines - EISPACK Guide, Springer-Verlag,
+C                 1976.
+C               C. H. Reinsch, Eigenvalues of a real, symmetric, tri-
+C                 diagonal matrix, Algorithm 464, Communications of the
+C                 ACM 16, 11 (November 1973), pp. 689.
+C***ROUTINES CALLED  PYTHAG, R1MACH
+C***REVISION HISTORY  (YYMMDD)
+C   760101  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  TQLRAT
+C
+      INTEGER I,J,L,M,N,II,L1,MML,IERR
+      REAL D(*),E2(*)
+      REAL B,C,F,G,H,P,R,S,MACHEP
+      REAL PYTHAG
+      LOGICAL FIRST
+C
+      SAVE FIRST, MACHEP
+      DATA FIRST /.TRUE./
+C***FIRST EXECUTABLE STATEMENT  TQLRAT
+      IF (FIRST) THEN
+         MACHEP = R1MACH(4)
+      ENDIF
+      FIRST = .FALSE.
+C
+      IERR = 0
+      IF (N .EQ. 1) GO TO 1001
+C
+      DO 100 I = 2, N
+  100 E2(I-1) = E2(I)
+C
+      F = 0.0E0
+      B = 0.0E0
+      E2(N) = 0.0E0
+C
+      DO 290 L = 1, N
+         J = 0
+         H = MACHEP * (ABS(D(L)) + SQRT(E2(L)))
+         IF (B .GT. H) GO TO 105
+         B = H
+         C = B * B
+C     .......... LOOK FOR SMALL SQUARED SUB-DIAGONAL ELEMENT ..........
+  105    DO 110 M = L, N
+            IF (E2(M) .LE. C) GO TO 120
+C     .......... E2(N) IS ALWAYS ZERO, SO THERE IS NO EXIT
+C                THROUGH THE BOTTOM OF THE LOOP ..........
+  110    CONTINUE
+C
+  120    IF (M .EQ. L) GO TO 210
+  130    IF (J .EQ. 30) GO TO 1000
+         J = J + 1
+C     .......... FORM SHIFT ..........
+         L1 = L + 1
+         S = SQRT(E2(L))
+         G = D(L)
+         P = (D(L1) - G) / (2.0E0 * S)
+         R = PYTHAG(P,1.0E0)
+         D(L) = S / (P + SIGN(R,P))
+         H = G - D(L)
+C
+         DO 140 I = L1, N
+  140    D(I) = D(I) - H
+C
+         F = F + H
+C     .......... RATIONAL QL TRANSFORMATION ..........
+         G = D(M)
+         IF (G .EQ. 0.0E0) G = B
+         H = G
+         S = 0.0E0
+         MML = M - L
+C     .......... FOR I=M-1 STEP -1 UNTIL L DO -- ..........
+         DO 200 II = 1, MML
+            I = M - II
+            P = G * H
+            R = P + E2(I)
+            E2(I+1) = S * R
+            S = E2(I) / R
+            D(I+1) = H + S * (H + D(I))
+            G = D(I) - E2(I) / G
+            IF (G .EQ. 0.0E0) G = B
+            H = G * P / R
+  200    CONTINUE
+C
+         E2(L) = S * G
+         D(L) = H
+C     .......... GUARD AGAINST UNDERFLOW IN CONVERGENCE TEST ..........
+         IF (H .EQ. 0.0E0) GO TO 210
+         IF (ABS(E2(L)) .LE. ABS(C/H)) GO TO 210
+         E2(L) = H * E2(L)
+         IF (E2(L) .NE. 0.0E0) GO TO 130
+  210    P = D(L) + F
+C     .......... ORDER EIGENVALUES ..........
+         IF (L .EQ. 1) GO TO 250
+C     .......... FOR I=L STEP -1 UNTIL 2 DO -- ..........
+         DO 230 II = 2, L
+            I = L + 2 - II
+            IF (P .GE. D(I-1)) GO TO 270
+            D(I) = D(I-1)
+  230    CONTINUE
+C
+  250    I = 1
+  270    D(I) = P
+  290 CONTINUE
+C
+      GO TO 1001
+C     .......... SET ERROR -- NO CONVERGENCE TO AN
+C                EIGENVALUE AFTER 30 ITERATIONS ..........
+ 1000 IERR = L
+ 1001 RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/tred1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/tred1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,142 @@
+*DECK TRED1
+      SUBROUTINE TRED1 (NM, N, A, D, E, E2)
+C***BEGIN PROLOGUE  TRED1
+C***PURPOSE  Reduce a real symmetric matrix to symmetric tridiagonal
+C            matrix using orthogonal similarity transformations.
+C***LIBRARY   SLATEC (EISPACK)
+C***CATEGORY  D4C1B1
+C***TYPE      SINGLE PRECISION (TRED1-S)
+C***KEYWORDS  EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR  Smith, B. T., et al.
+C***DESCRIPTION
+C
+C     This subroutine is a translation of the ALGOL procedure TRED1,
+C     NUM. MATH. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
+C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
+C
+C     This subroutine reduces a REAL SYMMETRIC matrix
+C     to a symmetric tridiagonal matrix using
+C     orthogonal similarity transformations.
+C
+C     On Input
+C
+C        NM must be set to the row dimension of the two-dimensional
+C          array parameter, A, as declared in the calling program
+C          dimension statement.  NM is an INTEGER variable.
+C
+C        N is the order of the matrix A.  N is an INTEGER variable.
+C          N must be less than or equal to NM.
+C
+C        A contains the real symmetric input matrix.  Only the lower
+C          triangle of the matrix need be supplied.  A is a two-
+C          dimensional REAL array, dimensioned A(NM,N).
+C
+C     On Output
+C
+C        A contains information about the orthogonal transformations
+C          used in the reduction in its strict lower triangle.  The
+C          full upper triangle of A is unaltered.
+C
+C        D contains the diagonal elements of the symmetric tridiagonal
+C          matrix.  D is a one-dimensional REAL array, dimensioned D(N).
+C
+C        E contains the subdiagonal elements of the symmetric
+C          tridiagonal matrix in its last N-1 positions.  E(1) is set
+C          to zero.  E is a one-dimensional REAL array, dimensioned
+C          E(N).
+C
+C        E2 contains the squares of the corresponding elements of E.
+C          E2 may coincide with E if the squares are not needed.
+C          E2 is a one-dimensional REAL array, dimensioned E2(N).
+C
+C     Questions and comments should be directed to B. S. Garbow,
+C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C     ------------------------------------------------------------------
+C
+C***REFERENCES  B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C                 Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C                 system Routines - EISPACK Guide, Springer-Verlag,
+C                 1976.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   760101  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  TRED1
+C
+      INTEGER I,J,K,L,N,II,NM,JP1
+      REAL A(NM,*),D(*),E(*),E2(*)
+      REAL F,G,H,SCALE
+C
+C***FIRST EXECUTABLE STATEMENT  TRED1
+      DO 100 I = 1, N
+  100 D(I) = A(I,I)
+C     .......... FOR I=N STEP -1 UNTIL 1 DO -- ..........
+      DO 300 II = 1, N
+         I = N + 1 - II
+         L = I - 1
+         H = 0.0E0
+         SCALE = 0.0E0
+         IF (L .LT. 1) GO TO 130
+C     .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) ..........
+         DO 120 K = 1, L
+  120    SCALE = SCALE + ABS(A(I,K))
+C
+         IF (SCALE .NE. 0.0E0) GO TO 140
+  130    E(I) = 0.0E0
+         E2(I) = 0.0E0
+         GO TO 290
+C
+  140    DO 150 K = 1, L
+            A(I,K) = A(I,K) / SCALE
+            H = H + A(I,K) * A(I,K)
+  150    CONTINUE
+C
+         E2(I) = SCALE * SCALE * H
+         F = A(I,L)
+         G = -SIGN(SQRT(H),F)
+         E(I) = SCALE * G
+         H = H - F * G
+         A(I,L) = F - G
+         IF (L .EQ. 1) GO TO 270
+         F = 0.0E0
+C
+         DO 240 J = 1, L
+            G = 0.0E0
+C     .......... FORM ELEMENT OF A*U ..........
+            DO 180 K = 1, J
+  180       G = G + A(J,K) * A(I,K)
+C
+            JP1 = J + 1
+            IF (L .LT. JP1) GO TO 220
+C
+            DO 200 K = JP1, L
+  200       G = G + A(K,J) * A(I,K)
+C     .......... FORM ELEMENT OF P ..........
+  220       E(J) = G / H
+            F = F + E(J) * A(I,J)
+  240    CONTINUE
+C
+         H = F / (H + H)
+C     .......... FORM REDUCED A ..........
+         DO 260 J = 1, L
+            F = A(I,J)
+            G = E(J) - H * F
+            E(J) = G
+C
+            DO 260 K = 1, J
+               A(J,K) = A(J,K) - F * E(K) - G * A(I,K)
+  260    CONTINUE
+C
+  270    DO 280 K = 1, L
+  280    A(I,K) = SCALE * A(I,K)
+C
+  290    H = D(I)
+         D(I) = A(I,I)
+         A(I,I) = H
+  300 CONTINUE
+C
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/tred2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/tred2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,166 @@
+*DECK TRED2
+      SUBROUTINE TRED2 (NM, N, A, D, E, Z)
+C***BEGIN PROLOGUE  TRED2
+C***PURPOSE  Reduce a real symmetric matrix to a symmetric tridiagonal
+C            matrix using and accumulating orthogonal transformations.
+C***LIBRARY   SLATEC (EISPACK)
+C***CATEGORY  D4C1B1
+C***TYPE      SINGLE PRECISION (TRED2-S)
+C***KEYWORDS  EIGENVALUES, EIGENVECTORS, EISPACK
+C***AUTHOR  Smith, B. T., et al.
+C***DESCRIPTION
+C
+C     This subroutine is a translation of the ALGOL procedure TRED2,
+C     NUM. MATH. 11, 181-195(1968) by Martin, Reinsch, and Wilkinson.
+C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971).
+C
+C     This subroutine reduces a REAL SYMMETRIC matrix to a
+C     symmetric tridiagonal matrix using and accumulating
+C     orthogonal similarity transformations.
+C
+C     On Input
+C
+C        NM must be set to the row dimension of the two-dimensional
+C          array parameters, A and Z, as declared in the calling
+C          program dimension statement.  NM is an INTEGER variable.
+C
+C        N is the order of the matrix A.  N is an INTEGER variable.
+C          N must be less than or equal to NM.
+C
+C        A contains the real symmetric input matrix.  Only the lower
+C          triangle of the matrix need be supplied.  A is a two-
+C          dimensional REAL array, dimensioned A(NM,N).
+C
+C     On Output
+C
+C        D contains the diagonal elements of the symmetric tridiagonal
+C          matrix.  D is a one-dimensional REAL array, dimensioned D(N).
+C
+C        E contains the subdiagonal elements of the symmetric
+C          tridiagonal matrix in its last N-1 positions.  E(1) is set
+C          to zero.  E is a one-dimensional REAL array, dimensioned
+C          E(N).
+C
+C        Z contains the orthogonal transformation matrix produced in
+C          the reduction.  Z is a two-dimensional REAL array,
+C          dimensioned Z(NM,N).
+C
+C        A and Z may coincide.  If distinct, A is unaltered.
+C
+C     Questions and comments should be directed to B. S. Garbow,
+C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
+C     ------------------------------------------------------------------
+C
+C***REFERENCES  B. T. Smith, J. M. Boyle, J. J. Dongarra, B. S. Garbow,
+C                 Y. Ikebe, V. C. Klema and C. B. Moler, Matrix Eigen-
+C                 system Routines - EISPACK Guide, Springer-Verlag,
+C                 1976.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   760101  DATE WRITTEN
+C   890831  Modified array declarations.  (WRB)
+C   890831  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  TRED2
+C
+      INTEGER I,J,K,L,N,II,NM,JP1
+      REAL A(NM,*),D(*),E(*),Z(NM,*)
+      REAL F,G,H,HH,SCALE
+C
+C***FIRST EXECUTABLE STATEMENT  TRED2
+      DO 100 I = 1, N
+C
+         DO 100 J = 1, I
+            Z(I,J) = A(I,J)
+  100 CONTINUE
+C
+      IF (N .EQ. 1) GO TO 320
+C     .......... FOR I=N STEP -1 UNTIL 2 DO -- ..........
+      DO 300 II = 2, N
+         I = N + 2 - II
+         L = I - 1
+         H = 0.0E0
+         SCALE = 0.0E0
+         IF (L .LT. 2) GO TO 130
+C     .......... SCALE ROW (ALGOL TOL THEN NOT NEEDED) ..........
+         DO 120 K = 1, L
+  120    SCALE = SCALE + ABS(Z(I,K))
+C
+         IF (SCALE .NE. 0.0E0) GO TO 140
+  130    E(I) = Z(I,L)
+         GO TO 290
+C
+  140    DO 150 K = 1, L
+            Z(I,K) = Z(I,K) / SCALE
+            H = H + Z(I,K) * Z(I,K)
+  150    CONTINUE
+C
+         F = Z(I,L)
+         G = -SIGN(SQRT(H),F)
+         E(I) = SCALE * G
+         H = H - F * G
+         Z(I,L) = F - G
+         F = 0.0E0
+C
+         DO 240 J = 1, L
+            Z(J,I) = Z(I,J) / H
+            G = 0.0E0
+C     .......... FORM ELEMENT OF A*U ..........
+            DO 180 K = 1, J
+  180       G = G + Z(J,K) * Z(I,K)
+C
+            JP1 = J + 1
+            IF (L .LT. JP1) GO TO 220
+C
+            DO 200 K = JP1, L
+  200       G = G + Z(K,J) * Z(I,K)
+C     .......... FORM ELEMENT OF P ..........
+  220       E(J) = G / H
+            F = F + E(J) * Z(I,J)
+  240    CONTINUE
+C
+         HH = F / (H + H)
+C     .......... FORM REDUCED A ..........
+         DO 260 J = 1, L
+            F = Z(I,J)
+            G = E(J) - HH * F
+            E(J) = G
+C
+            DO 260 K = 1, J
+               Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K)
+  260    CONTINUE
+C
+  290    D(I) = H
+  300 CONTINUE
+C
+  320 D(1) = 0.0E0
+      E(1) = 0.0E0
+C     .......... ACCUMULATION OF TRANSFORMATION MATRICES ..........
+      DO 500 I = 1, N
+         L = I - 1
+         IF (D(I) .EQ. 0.0E0) GO TO 380
+C
+         DO 360 J = 1, L
+            G = 0.0E0
+C
+            DO 340 K = 1, L
+  340       G = G + Z(I,K) * Z(K,J)
+C
+            DO 360 K = 1, L
+               Z(K,J) = Z(K,J) - G * Z(K,I)
+  360    CONTINUE
+C
+  380    D(I) = Z(I,I)
+         Z(I,I) = 1.0E0
+         IF (L .LT. 1) GO TO 500
+C
+         DO 400 J = 1, L
+            Z(I,J) = 0.0E0
+            Z(J,I) = 0.0E0
+  400    CONTINUE
+C
+  500 CONTINUE
+C
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xercnt.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xercnt.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,62 @@
+*DECK XERCNT
+c changed by setting KONTRL=0 
+      SUBROUTINE XERCNT (LIBRAR, SUBROU, MESSG, NERR, LEVEL, KONTRL)
+C***BEGIN PROLOGUE  XERCNT
+C***SUBSIDIARY
+C***PURPOSE  Allow user control over handling of errors.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERCNT-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        Allows user control over handling of individual errors.
+C        Just after each message is recorded, but before it is
+C        processed any further (i.e., before it is printed or
+C        a decision to abort is made), a call is made to XERCNT.
+C        If the user has provided his own version of XERCNT, he
+C        can then override the value of KONTROL used in processing
+C        this message by redefining its value.
+C        KONTRL may be set to any value from -2 to 2.
+C        The meanings for KONTRL are the same as in XSETF, except
+C        that the value of KONTRL changes only for this message.
+C        If KONTRL is set to a value outside the range from -2 to 2,
+C        it will be moved back into that range.
+C
+C     Description of Parameters
+C
+C      --Input--
+C        LIBRAR - the library that the routine is in.
+C        SUBROU - the subroutine that XERMSG is being called from
+C        MESSG  - the first 20 characters of the error message.
+C        NERR   - same as in the call to XERMSG.
+C        LEVEL  - same as in the call to XERMSG.
+C        KONTRL - the current value of the control flag as set
+C                 by a call to XSETF.
+C
+C      --Output--
+C        KONTRL - the new value of KONTRL.  If KONTRL is not
+C                 defined, it will remain at its original value.
+C                 This changed value of control affects only
+C                 the current occurrence of the current message.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900206  Routine changed from user-callable to subsidiary.  (WRB)
+C   900510  Changed calling sequence to include LIBRARY and SUBROUTINE
+C           names, changed routine name from XERCTL to XERCNT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERCNT
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+C***FIRST EXECUTABLE STATEMENT  XERCNT
+      KONTRL=0
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xerhlt.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xerhlt.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,39 @@
+*DECK XERHLT
+      SUBROUTINE XERHLT (MESSG)
+C***BEGIN PROLOGUE  XERHLT
+C***SUBSIDIARY
+C***PURPOSE  Abort program execution and print error message.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERHLT-A)
+C***KEYWORDS  ABORT PROGRAM EXECUTION, ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        ***Note*** machine dependent routine
+C        XERHLT aborts the execution of the program.
+C        The error message causing the abort is given in the calling
+C        sequence, in case one needs it for printing on a dayfile,
+C        for example.
+C
+C     Description of Parameters
+C        MESSG is as in XERMSG.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  (NONE)
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900206  Routine changed from user-callable to subsidiary.  (WRB)
+C   900510  Changed calling sequence to delete length of character
+C           and changed routine name from XERABT to XERHLT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERHLT
+      CHARACTER*(*) MESSG
+C***FIRST EXECUTABLE STATEMENT  XERHLT
+      STOP
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xermsg.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xermsg.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,364 @@
+*DECK XERMSG
+      SUBROUTINE XERMSG (LIBRAR, SUBROU, MESSG, NERR, LEVEL)
+C***BEGIN PROLOGUE  XERMSG
+C***PURPOSE  Process error messages for SLATEC and other libraries.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERMSG-A)
+C***KEYWORDS  ERROR MESSAGE, XERROR
+C***AUTHOR  Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C   XERMSG processes a diagnostic message in a manner determined by the
+C   value of LEVEL and the current value of the library error control
+C   flag, KONTRL.  See subroutine XSETF for details.
+C
+C    LIBRAR   A character constant (or character variable) with the name
+C             of the library.  This will be 'SLATEC' for the SLATEC
+C             Common Math Library.  The error handling package is
+C             general enough to be used by many libraries
+C             simultaneously, so it is desirable for the routine that
+C             detects and reports an error to identify the library name
+C             as well as the routine name.
+C
+C    SUBROU   A character constant (or character variable) with the name
+C             of the routine that detected the error.  Usually it is the
+C             name of the routine that is calling XERMSG.  There are
+C             some instances where a user callable library routine calls
+C             lower level subsidiary routines where the error is
+C             detected.  In such cases it may be more informative to
+C             supply the name of the routine the user called rather than
+C             the name of the subsidiary routine that detected the
+C             error.
+C
+C    MESSG    A character constant (or character variable) with the text
+C             of the error or warning message.  In the example below,
+C             the message is a character constant that contains a
+C             generic message.
+C
+C                   CALL XERMSG ('SLATEC', 'MMPY',
+C                  *'THE ORDER OF THE MATRIX EXCEEDS THE ROW DIMENSION',
+C                  *3, 1)
+C
+C             It is possible (and is sometimes desirable) to generate a
+C             specific message--e.g., one that contains actual numeric
+C             values.  Specific numeric values can be converted into
+C             character strings using formatted WRITE statements into
+C             character variables.  This is called standard Fortran
+C             internal file I/O and is exemplified in the first three
+C             lines of the following example.  You can also catenate
+C             substrings of characters to construct the error message.
+C             Here is an example showing the use of both writing to
+C             an internal file and catenating character strings.
+C
+C                   CHARACTER*5 CHARN, CHARL
+C                   WRITE (CHARN,10) N
+C                   WRITE (CHARL,10) LDA
+C                10 FORMAT(I5)
+C                   CALL XERMSG ('SLATEC', 'MMPY', 'THE ORDER'//CHARN//
+C                  *   ' OF THE MATRIX EXCEEDS ITS ROW DIMENSION OF'//
+C                  *   CHARL, 3, 1)
+C
+C             There are two subtleties worth mentioning.  One is that
+C             the // for character catenation is used to construct the
+C             error message so that no single character constant is
+C             continued to the next line.  This avoids confusion as to
+C             whether there are trailing blanks at the end of the line.
+C             The second is that by catenating the parts of the message
+C             as an actual argument rather than encoding the entire
+C             message into one large character variable, we avoid
+C             having to know how long the message will be in order to
+C             declare an adequate length for that large character
+C             variable.  XERMSG calls XERPRN to print the message using
+C             multiple lines if necessary.  If the message is very long,
+C             XERPRN will break it into pieces of 72 characters (as
+C             requested by XERMSG) for printing on multiple lines.
+C             Also, XERMSG asks XERPRN to prefix each line with ' *  '
+C             so that the total line length could be 76 characters.
+C             Note also that XERPRN scans the error message backwards
+C             to ignore trailing blanks.  Another feature is that
+C             the substring '$$' is treated as a new line sentinel
+C             by XERPRN.  If you want to construct a multiline
+C             message without having to count out multiples of 72
+C             characters, just use '$$' as a separator.  '$$'
+C             obviously must occur within 72 characters of the
+C             start of each line to have its intended effect since
+C             XERPRN is asked to wrap around at 72 characters in
+C             addition to looking for '$$'.
+C
+C    NERR     An integer value that is chosen by the library routine's
+C             author.  It must be in the range -99 to 999 (three
+C             printable digits).  Each distinct error should have its
+C             own error number.  These error numbers should be described
+C             in the machine readable documentation for the routine.
+C             The error numbers need be unique only within each routine,
+C             so it is reasonable for each routine to start enumerating
+C             errors from 1 and proceeding to the next integer.
+C
+C    LEVEL    An integer value in the range 0 to 2 that indicates the
+C             level (severity) of the error.  Their meanings are
+C
+C            -1  A warning message.  This is used if it is not clear
+C                that there really is an error, but the user's attention
+C                may be needed.  An attempt is made to only print this
+C                message once.
+C
+C             0  A warning message.  This is used if it is not clear
+C                that there really is an error, but the user's attention
+C                may be needed.
+C
+C             1  A recoverable error.  This is used even if the error is
+C                so serious that the routine cannot return any useful
+C                answer.  If the user has told the error package to
+C                return after recoverable errors, then XERMSG will
+C                return to the Library routine which can then return to
+C                the user's routine.  The user may also permit the error
+C                package to terminate the program upon encountering a
+C                recoverable error.
+C
+C             2  A fatal error.  XERMSG will not return to its caller
+C                after it receives a fatal error.  This level should
+C                hardly ever be used; it is much better to allow the
+C                user a chance to recover.  An example of one of the few
+C                cases in which it is permissible to declare a level 2
+C                error is a reverse communication Library routine that
+C                is likely to be called repeatedly until it integrates
+C                across some interval.  If there is a serious error in
+C                the input such that another step cannot be taken and
+C                the Library routine is called again without the input
+C                error having been corrected by the caller, the Library
+C                routine will probably be called forever with improper
+C                input.  In this case, it is reasonable to declare the
+C                error to be fatal.
+C
+C    Each of the arguments to XERMSG is input; none will be modified by
+C    XERMSG.  A routine may make multiple calls to XERMSG with warning
+C    level messages; however, after a call to XERMSG with a recoverable
+C    error, the routine should return to the user.  Do not try to call
+C    XERMSG with a second recoverable error after the first recoverable
+C    error because the error package saves the error number.  The user
+C    can retrieve this error number by calling another entry point in
+C    the error handling package and then clear the error number when
+C    recovering from the error.  Calling XERMSG in succession causes the
+C    old error number to be overwritten by the latest error number.
+C    This is considered harmless for error numbers associated with
+C    warning messages but must not be done for error numbers of serious
+C    errors.  After a call to XERMSG with a recoverable error, the user
+C    must be given a chance to call NUMXER or XERCLR to retrieve or
+C    clear the error number.
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  FDUMP, J4SAVE, XERCNT, XERHLT, XERPRN, XERSVE
+C***REVISION HISTORY  (YYMMDD)
+C   880101  DATE WRITTEN
+C   880621  REVISED AS DIRECTED AT SLATEC CML MEETING OF FEBRUARY 1988.
+C           THERE ARE TWO BASIC CHANGES.
+C           1.  A NEW ROUTINE, XERPRN, IS USED INSTEAD OF XERPRT TO
+C               PRINT MESSAGES.  THIS ROUTINE WILL BREAK LONG MESSAGES
+C               INTO PIECES FOR PRINTING ON MULTIPLE LINES.  '$$' IS
+C               ACCEPTED AS A NEW LINE SENTINEL.  A PREFIX CAN BE
+C               ADDED TO EACH LINE TO BE PRINTED.  XERMSG USES EITHER
+C               ' ***' OR ' *  ' AND LONG MESSAGES ARE BROKEN EVERY
+C               72 CHARACTERS (AT MOST) SO THAT THE MAXIMUM LINE
+C               LENGTH OUTPUT CAN NOW BE AS GREAT AS 76.
+C           2.  THE TEXT OF ALL MESSAGES IS NOW IN UPPER CASE SINCE THE
+C               FORTRAN STANDARD DOCUMENT DOES NOT ADMIT THE EXISTENCE
+C               OF LOWER CASE.
+C   880708  REVISED AFTER THE SLATEC CML MEETING OF JUNE 29 AND 30.
+C           THE PRINCIPAL CHANGES ARE
+C           1.  CLARIFY COMMENTS IN THE PROLOGUES
+C           2.  RENAME XRPRNT TO XERPRN
+C           3.  REWORK HANDLING OF '$$' IN XERPRN TO HANDLE BLANK LINES
+C               SIMILAR TO THE WAY FORMAT STATEMENTS HANDLE THE /
+C               CHARACTER FOR NEW RECORDS.
+C   890706  REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C           CLEAN UP THE CODING.
+C   890721  REVISED TO USE NEW FEATURE IN XERPRN TO COUNT CHARACTERS IN
+C           PREFIX.
+C   891013  REVISED TO CORRECT COMMENTS.
+C   891214  Prologue converted to Version 4.0 format.  (WRB)
+C   900510  Changed test on NERR to be -9999999 < NERR < 99999999, but
+C           NERR .ne. 0, and on LEVEL to be -2 < LEVEL < 3.  Added
+C           LEVEL=-1 logic, changed calls to XERSAV to XERSVE, and
+C           XERCTL to XERCNT.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERMSG
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      CHARACTER*8 XLIBR, XSUBR
+      CHARACTER*72  TEMP
+      CHARACTER*20  LFIRST
+C***FIRST EXECUTABLE STATEMENT  XERMSG
+      LKNTRL = J4SAVE (2, 0, .FALSE.)
+      MAXMES = J4SAVE (4, 0, .FALSE.)
+C
+C       LKNTRL IS A LOCAL COPY OF THE CONTROL FLAG KONTRL.
+C       MAXMES IS THE MAXIMUM NUMBER OF TIMES ANY PARTICULAR MESSAGE
+C          SHOULD BE PRINTED.
+C
+C       WE PRINT A FATAL ERROR MESSAGE AND TERMINATE FOR AN ERROR IN
+C          CALLING XERMSG.  THE ERROR NUMBER SHOULD BE POSITIVE,
+C          AND THE LEVEL SHOULD BE BETWEEN 0 AND 2.
+C
+      IF (NERR.LT.-9999999 .OR. NERR.GT.99999999 .OR. NERR.EQ.0 .OR.
+     *   LEVEL.LT.-1 .OR. LEVEL.GT.2) THEN
+         CALL XERPRN (' ***', -1, 'FATAL ERROR IN...$$ ' //
+     *      'XERMSG -- INVALID ERROR NUMBER OR LEVEL$$ '//
+     *      'JOB ABORT DUE TO FATAL ERROR.', 72)
+         CALL XERSVE (' ', ' ', ' ', 0, 0, 0, KDUMMY)
+         CALL XERHLT (' ***XERMSG -- INVALID INPUT')
+         RETURN
+      ENDIF
+C
+C       RECORD THE MESSAGE.
+C
+      I = J4SAVE (1, NERR, .TRUE.)
+      CALL XERSVE (LIBRAR, SUBROU, MESSG, 1, NERR, LEVEL, KOUNT)
+C
+C       HANDLE PRINT-ONCE WARNING MESSAGES.
+C
+      IF (LEVEL.EQ.-1 .AND. KOUNT.GT.1) RETURN
+C
+C       ALLOW TEMPORARY USER OVERRIDE OF THE CONTROL FLAG.
+C
+      XLIBR  = LIBRAR
+      XSUBR  = SUBROU
+      LFIRST = MESSG
+      LERR   = NERR
+      LLEVEL = LEVEL
+      CALL XERCNT (XLIBR, XSUBR, LFIRST, LERR, LLEVEL, LKNTRL)
+C
+      LKNTRL = MAX(-2, MIN(2,LKNTRL))
+      MKNTRL = ABS(LKNTRL)
+C
+C       SKIP PRINTING IF THE CONTROL FLAG VALUE AS RESET IN XERCNT IS
+C       ZERO AND THE ERROR IS NOT FATAL.
+C
+      IF (LEVEL.LT.2 .AND. LKNTRL.EQ.0) GO TO 30
+      IF (LEVEL.EQ.0 .AND. KOUNT.GT.MAXMES) GO TO 30
+      IF (LEVEL.EQ.1 .AND. KOUNT.GT.MAXMES .AND. MKNTRL.EQ.1) GO TO 30
+      IF (LEVEL.EQ.2 .AND. KOUNT.GT.MAX(1,MAXMES)) GO TO 30
+C
+C       ANNOUNCE THE NAMES OF THE LIBRARY AND SUBROUTINE BY BUILDING A
+C       MESSAGE IN CHARACTER VARIABLE TEMP (NOT EXCEEDING 66 CHARACTERS)
+C       AND SENDING IT OUT VIA XERPRN.  PRINT ONLY IF CONTROL FLAG
+C       IS NOT ZERO.
+C
+      IF (LKNTRL .NE. 0) THEN
+         TEMP(1:21) = 'MESSAGE FROM ROUTINE '
+         I = MIN(LEN(SUBROU), 16)
+         TEMP(22:21+I) = SUBROU(1:I)
+         TEMP(22+I:33+I) = ' IN LIBRARY '
+         LTEMP = 33 + I
+         I = MIN(LEN(LIBRAR), 16)
+         TEMP(LTEMP+1:LTEMP+I) = LIBRAR (1:I)
+         TEMP(LTEMP+I+1:LTEMP+I+1) = '.'
+         LTEMP = LTEMP + I + 1
+         CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+      ENDIF
+C
+C       IF LKNTRL IS POSITIVE, PRINT AN INTRODUCTORY LINE BEFORE
+C       PRINTING THE MESSAGE.  THE INTRODUCTORY LINE TELLS THE CHOICE
+C       FROM EACH OF THE FOLLOWING THREE OPTIONS.
+C       1.  LEVEL OF THE MESSAGE
+C              'INFORMATIVE MESSAGE'
+C              'POTENTIALLY RECOVERABLE ERROR'
+C              'FATAL ERROR'
+C       2.  WHETHER CONTROL FLAG WILL ALLOW PROGRAM TO CONTINUE
+C              'PROG CONTINUES'
+C              'PROG ABORTED'
+C       3.  WHETHER OR NOT A TRACEBACK WAS REQUESTED.  (THE TRACEBACK
+C           MAY NOT BE IMPLEMENTED AT SOME SITES, SO THIS ONLY TELLS
+C           WHAT WAS REQUESTED, NOT WHAT WAS DELIVERED.)
+C              'TRACEBACK REQUESTED'
+C              'TRACEBACK NOT REQUESTED'
+C       NOTICE THAT THE LINE INCLUDING FOUR PREFIX CHARACTERS WILL NOT
+C       EXCEED 74 CHARACTERS.
+C       WE SKIP THE NEXT BLOCK IF THE INTRODUCTORY LINE IS NOT NEEDED.
+C
+      IF (LKNTRL .GT. 0) THEN
+C
+C       THE FIRST PART OF THE MESSAGE TELLS ABOUT THE LEVEL.
+C
+         IF (LEVEL .LE. 0) THEN
+            TEMP(1:20) = 'INFORMATIVE MESSAGE,'
+            LTEMP = 20
+         ELSEIF (LEVEL .EQ. 1) THEN
+            TEMP(1:30) = 'POTENTIALLY RECOVERABLE ERROR,'
+            LTEMP = 30
+         ELSE
+            TEMP(1:12) = 'FATAL ERROR,'
+            LTEMP = 12
+         ENDIF
+C
+C       THEN WHETHER THE PROGRAM WILL CONTINUE.
+C
+         IF ((MKNTRL.EQ.2 .AND. LEVEL.GE.1) .OR.
+     *       (MKNTRL.EQ.1 .AND. LEVEL.EQ.2)) THEN
+            TEMP(LTEMP+1:LTEMP+14) = ' PROG ABORTED,'
+            LTEMP = LTEMP + 14
+         ELSE
+            TEMP(LTEMP+1:LTEMP+16) = ' PROG CONTINUES,'
+            LTEMP = LTEMP + 16
+         ENDIF
+C
+C       FINALLY TELL WHETHER THERE SHOULD BE A TRACEBACK.
+C
+         IF (LKNTRL .GT. 0) THEN
+            TEMP(LTEMP+1:LTEMP+20) = ' TRACEBACK REQUESTED'
+            LTEMP = LTEMP + 20
+         ELSE
+            TEMP(LTEMP+1:LTEMP+24) = ' TRACEBACK NOT REQUESTED'
+            LTEMP = LTEMP + 24
+         ENDIF
+         CALL XERPRN (' ***', -1, TEMP(1:LTEMP), 72)
+      ENDIF
+C
+C       NOW SEND OUT THE MESSAGE.
+C
+      CALL XERPRN (' *  ', -1, MESSG, 72)
+C
+C       IF LKNTRL IS POSITIVE, WRITE THE ERROR NUMBER AND REQUEST A
+C          TRACEBACK.
+C
+      IF (LKNTRL .GT. 0) THEN
+         WRITE (TEMP, '(''ERROR NUMBER = '', I8)') NERR
+         DO 10 I=16,22
+            IF (TEMP(I:I) .NE. ' ') GO TO 20
+   10    CONTINUE
+C
+   20    CALL XERPRN (' *  ', -1, TEMP(1:15) // TEMP(I:23), 72)
+         CALL FDUMP
+      ENDIF
+C
+C       IF LKNTRL IS NOT ZERO, PRINT A BLANK LINE AND AN END OF MESSAGE.
+C
+      IF (LKNTRL .NE. 0) THEN
+         CALL XERPRN (' *  ', -1, ' ', 72)
+         CALL XERPRN (' ***', -1, 'END OF MESSAGE', 72)
+         CALL XERPRN ('    ',  0, ' ', 72)
+      ENDIF
+C
+C       IF THE ERROR IS NOT FATAL OR THE ERROR IS RECOVERABLE AND THE
+C       CONTROL FLAG IS SET FOR RECOVERY, THEN RETURN.
+C
+   30 IF (LEVEL.LE.0 .OR. (LEVEL.EQ.1 .AND. MKNTRL.LE.1)) RETURN
+C
+C       THE PROGRAM WILL BE STOPPED DUE TO AN UNRECOVERED ERROR OR A
+C       FATAL ERROR.  PRINT THE REASON FOR THE ABORT AND THE ERROR
+C       SUMMARY IF THE CONTROL FLAG AND THE MAXIMUM ERROR COUNT PERMIT.
+C
+      IF (LKNTRL.GT.0 .AND. KOUNT.LT.MAX(1,MAXMES)) THEN
+         IF (LEVEL .EQ. 1) THEN
+            CALL XERPRN
+     *         (' ***', -1, 'JOB ABORT DUE TO UNRECOVERED ERROR.', 72)
+         ELSE
+            CALL XERPRN(' ***', -1, 'JOB ABORT DUE TO FATAL ERROR.', 72)
+         ENDIF
+         CALL XERSVE (' ', ' ', ' ', -1, 0, 0, KDUMMY)
+         CALL XERHLT (' ')
+      ELSE
+         CALL XERHLT (MESSG)
+      ENDIF
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xerprn.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xerprn.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,228 @@
+*DECK XERPRN
+      SUBROUTINE XERPRN (PREFIX, NPREF, MESSG, NWRAP)
+C***BEGIN PROLOGUE  XERPRN
+C***SUBSIDIARY
+C***PURPOSE  Print error messages processed by XERMSG.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XERPRN-A)
+C***KEYWORDS  ERROR MESSAGES, PRINTING, XERROR
+C***AUTHOR  Fong, Kirby, (NMFECC at LLNL)
+C***DESCRIPTION
+C
+C This routine sends one or more lines to each of the (up to five)
+C logical units to which error messages are to be sent.  This routine
+C is called several times by XERMSG, sometimes with a single line to
+C print and sometimes with a (potentially very long) message that may
+C wrap around into multiple lines.
+C
+C PREFIX  Input argument of type CHARACTER.  This argument contains
+C         characters to be put at the beginning of each line before
+C         the body of the message.  No more than 16 characters of
+C         PREFIX will be used.
+C
+C NPREF   Input argument of type INTEGER.  This argument is the number
+C         of characters to use from PREFIX.  If it is negative, the
+C         intrinsic function LEN is used to determine its length.  If
+C         it is zero, PREFIX is not used.  If it exceeds 16 or if
+C         LEN(PREFIX) exceeds 16, only the first 16 characters will be
+C         used.  If NPREF is positive and the length of PREFIX is less
+C         than NPREF, a copy of PREFIX extended with blanks to length
+C         NPREF will be used.
+C
+C MESSG   Input argument of type CHARACTER.  This is the text of a
+C         message to be printed.  If it is a long message, it will be
+C         broken into pieces for printing on multiple lines.  Each line
+C         will start with the appropriate prefix and be followed by a
+C         piece of the message.  NWRAP is the number of characters per
+C         piece; that is, after each NWRAP characters, we break and
+C         start a new line.  In addition the characters '$$' embedded
+C         in MESSG are a sentinel for a new line.  The counting of
+C         characters up to NWRAP starts over for each new line.  The
+C         value of NWRAP typically used by XERMSG is 72 since many
+C         older error messages in the SLATEC Library are laid out to
+C         rely on wrap-around every 72 characters.
+C
+C NWRAP   Input argument of type INTEGER.  This gives the maximum size
+C         piece into which to break MESSG for printing on multiple
+C         lines.  An embedded '$$' ends a line, and the count restarts
+C         at the following character.  If a line break does not occur
+C         on a blank (it would split a word) that word is moved to the
+C         next line.  Values of NWRAP less than 16 will be treated as
+C         16.  Values of NWRAP greater than 132 will be treated as 132.
+C         The actual line length will be NPREF + NWRAP after NPREF has
+C         been adjusted to fall between 0 and 16 and NWRAP has been
+C         adjusted to fall between 16 and 132.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  I1MACH, XGETUA
+C***REVISION HISTORY  (YYMMDD)
+C   880621  DATE WRITTEN
+C   880708  REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF
+C           JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK
+C           THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE
+C           SLASH CHARACTER IN FORMAT STATEMENTS.
+C   890706  REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO
+C           STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK
+C           LINES TO BE PRINTED.
+C   890721  REVISED TO ADD A NEW FEATURE.  A NEGATIVE VALUE OF NPREF
+C           CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.
+C   891013  REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.
+C   891214  Prologue converted to Version 4.0 format.  (WRB)
+C   900510  Added code to break messages between words.  (RWC)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERPRN
+      CHARACTER*(*) PREFIX, MESSG
+      INTEGER NPREF, NWRAP
+      CHARACTER*148 CBUFF
+      INTEGER IU(5), NUNIT
+      CHARACTER*2 NEWLIN
+      PARAMETER (NEWLIN = '$$')
+C***FIRST EXECUTABLE STATEMENT  XERPRN
+      CALL XGETUA(IU,NUNIT)
+C
+C       A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD
+C       ERROR MESSAGE UNIT INSTEAD.  I1MACH(4) RETRIEVES THE STANDARD
+C       ERROR MESSAGE UNIT.
+C
+      N = I1MACH(4)
+      DO 10 I=1,NUNIT
+         IF (IU(I) .EQ. 0) IU(I) = N
+   10 CONTINUE
+C
+C       LPREF IS THE LENGTH OF THE PREFIX.  THE PREFIX IS PLACED AT THE
+C       BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING
+C       THE REST OF THIS ROUTINE.
+C
+      IF ( NPREF .LT. 0 ) THEN
+         LPREF = LEN(PREFIX)
+      ELSE
+         LPREF = NPREF
+      ENDIF
+      LPREF = MIN(16, LPREF)
+      IF (LPREF .NE. 0) CBUFF(1:LPREF) = PREFIX
+C
+C       LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE
+C       TIME FROM MESSG TO PRINT ON ONE LINE.
+C
+      LWRAP = MAX(16, MIN(132, NWRAP))
+C
+C       SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.
+C
+      LENMSG = LEN(MESSG)
+      N = LENMSG
+      DO 20 I=1,N
+         IF (MESSG(LENMSG:LENMSG) .NE. ' ') GO TO 30
+         LENMSG = LENMSG - 1
+   20 CONTINUE
+   30 CONTINUE
+C
+C       IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.
+C
+      IF (LENMSG .EQ. 0) THEN
+         CBUFF(LPREF+1:LPREF+1) = ' '
+         DO 40 I=1,NUNIT
+            WRITE(IU(I), '(A)') CBUFF(1:LPREF+1)
+   40    CONTINUE
+         RETURN
+      ENDIF
+C
+C       SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING
+C       STARTS.  FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.
+C       WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.
+C       WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.
+C
+C       WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL.  THE
+C       INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE
+C       OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH
+C       OF THE SECOND ARGUMENT.
+C
+C       THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE
+C       FOLLOWING ORDER.  WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER
+C       OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT
+C       POSITION NEXTC.
+C
+C       LPIECE .EQ. 0   THE NEW LINE SENTINEL DOES NOT OCCUR IN THE
+C                       REMAINDER OF THE CHARACTER STRING.  LPIECE
+C                       SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,
+C                       WHICHEVER IS LESS.
+C
+C       LPIECE .EQ. 1   THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:
+C                       NEXTC).  LPIECE IS EFFECTIVELY ZERO, AND WE
+C                       PRINT NOTHING TO AVOID PRODUCING UNNECESSARY
+C                       BLANK LINES.  THIS TAKES CARE OF THE SITUATION
+C                       WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF
+C                       EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE
+C                       SENTINEL FOLLOWED BY MORE CHARACTERS.  NEXTC
+C                       SHOULD BE INCREMENTED BY 2.
+C
+C       LPIECE .GT. LWRAP+1  REDUCE LPIECE TO LWRAP.
+C
+C       ELSE            THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1
+C                       RESET LPIECE = LPIECE-1.  NOTE THAT THIS
+C                       PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.
+C                       LWRAP+1.  THAT IS, THE SENTINEL FALLS EXACTLY
+C                       AT THE END OF A LINE.
+C
+      NEXTC = 1
+   50 LPIECE = INDEX(MESSG(NEXTC:LENMSG), NEWLIN)
+      IF (LPIECE .EQ. 0) THEN
+C
+C       THERE WAS NO NEW LINE SENTINEL FOUND.
+C
+         IDELTA = 0
+         LPIECE = MIN(LWRAP, LENMSG+1-NEXTC)
+         IF (LPIECE .LT. LENMSG+1-NEXTC) THEN
+            DO 52 I=LPIECE+1,2,-1
+               IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+                  LPIECE = I-1
+                  IDELTA = 1
+                  GOTO 54
+               ENDIF
+   52       CONTINUE
+         ENDIF
+   54    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC = NEXTC + LPIECE + IDELTA
+      ELSEIF (LPIECE .EQ. 1) THEN
+C
+C       WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).
+C       DON'T PRINT A BLANK LINE.
+C
+         NEXTC = NEXTC + 2
+         GO TO 50
+      ELSEIF (LPIECE .GT. LWRAP+1) THEN
+C
+C       LPIECE SHOULD BE SET DOWN TO LWRAP.
+C
+         IDELTA = 0
+         LPIECE = LWRAP
+         DO 56 I=LPIECE+1,2,-1
+            IF (MESSG(NEXTC+I-1:NEXTC+I-1) .EQ. ' ') THEN
+               LPIECE = I-1
+               IDELTA = 1
+               GOTO 58
+            ENDIF
+   56    CONTINUE
+   58    CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC = NEXTC + LPIECE + IDELTA
+      ELSE
+C
+C       IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.
+C       WE SHOULD DECREMENT LPIECE BY ONE.
+C
+         LPIECE = LPIECE - 1
+         CBUFF(LPREF+1:LPREF+LPIECE) = MESSG(NEXTC:NEXTC+LPIECE-1)
+         NEXTC  = NEXTC + LPIECE + 2
+      ENDIF
+C
+C       PRINT
+C
+      DO 60 I=1,NUNIT
+         WRITE(IU(I), '(A)') CBUFF(1:LPREF+LPIECE)
+   60 CONTINUE
+C
+      IF (NEXTC .LE. LENMSG) GO TO 50
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xersve.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xersve.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,155 @@
+*DECK XERSVE
+      SUBROUTINE XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL,
+     +   ICOUNT)
+C***BEGIN PROLOGUE  XERSVE
+C***SUBSIDIARY
+C***PURPOSE  Record that an error has occurred.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3
+C***TYPE      ALL (XERSVE-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C *Usage:
+C
+C        INTEGER  KFLAG, NERR, LEVEL, ICOUNT
+C        CHARACTER * (len) LIBRAR, SUBROU, MESSG
+C
+C        CALL XERSVE (LIBRAR, SUBROU, MESSG, KFLAG, NERR, LEVEL, ICOUNT)
+C
+C *Arguments:
+C
+C        LIBRAR :IN    is the library that the message is from.
+C        SUBROU :IN    is the subroutine that the message is from.
+C        MESSG  :IN    is the message to be saved.
+C        KFLAG  :IN    indicates the action to be performed.
+C                      when KFLAG > 0, the message in MESSG is saved.
+C                      when KFLAG=0 the tables will be dumped and
+C                      cleared.
+C                      when KFLAG < 0, the tables will be dumped and
+C                      not cleared.
+C        NERR   :IN    is the error number.
+C        LEVEL  :IN    is the error severity.
+C        ICOUNT :OUT   the number of times this message has been seen,
+C                      or zero if the table has overflowed and does not
+C                      contain this message specifically.  When KFLAG=0,
+C                      ICOUNT will not be altered.
+C
+C *Description:
+C
+C   Record that this error occurred and possibly dump and clear the
+C   tables.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  I1MACH, XGETUA
+C***REVISION HISTORY  (YYMMDD)
+C   800319  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   900413  Routine modified to remove reference to KFLAG.  (WRB)
+C   900510  Changed to add LIBRARY NAME and SUBROUTINE to calling
+C           sequence, use IF-THEN-ELSE, make number of saved entries
+C           easily changeable, changed routine name from XERSAV to
+C           XERSVE.  (RWC)
+C   910626  Added LIBTAB and SUBTAB to SAVE statement.  (BKS)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XERSVE
+      PARAMETER (LENTAB=10)
+      INTEGER LUN(5)
+      CHARACTER*(*) LIBRAR, SUBROU, MESSG
+      CHARACTER*8  LIBTAB(LENTAB), SUBTAB(LENTAB), LIB, SUB
+      CHARACTER*20 MESTAB(LENTAB), MES
+      DIMENSION NERTAB(LENTAB), LEVTAB(LENTAB), KOUNT(LENTAB)
+      SAVE LIBTAB, SUBTAB, MESTAB, NERTAB, LEVTAB, KOUNT, KOUNTX, NMSG
+      DATA KOUNTX/0/, NMSG/0/
+C***FIRST EXECUTABLE STATEMENT  XERSVE
+C
+      IF (KFLAG.LE.0) THEN
+C
+C        Dump the table.
+C
+         IF (NMSG.EQ.0) RETURN
+C
+C        Print to each unit.
+C
+         CALL XGETUA (LUN, NUNIT)
+         DO 20 KUNIT = 1,NUNIT
+            IUNIT = LUN(KUNIT)
+            IF (IUNIT.EQ.0) IUNIT = I1MACH(4)
+C
+C           Print the table header.
+C
+            WRITE (IUNIT,9000)
+C
+C           Print body of table.
+C
+            DO 10 I = 1,NMSG
+               WRITE (IUNIT,9010) LIBTAB(I), SUBTAB(I), MESTAB(I),
+     *            NERTAB(I),LEVTAB(I),KOUNT(I)
+   10       CONTINUE
+C
+C           Print number of other errors.
+C
+            IF (KOUNTX.NE.0) WRITE (IUNIT,9020) KOUNTX
+            WRITE (IUNIT,9030)
+   20    CONTINUE
+C
+C        Clear the error tables.
+C
+         IF (KFLAG.EQ.0) THEN
+            NMSG = 0
+            KOUNTX = 0
+         ENDIF
+      ELSE
+C
+C        PROCESS A MESSAGE...
+C        SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG,
+C        OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL.
+C
+         LIB = LIBRAR
+         SUB = SUBROU
+         MES = MESSG
+         DO 30 I = 1,NMSG
+            IF (LIB.EQ.LIBTAB(I) .AND. SUB.EQ.SUBTAB(I) .AND.
+     *         MES.EQ.MESTAB(I) .AND. NERR.EQ.NERTAB(I) .AND.
+     *         LEVEL.EQ.LEVTAB(I)) THEN
+                  KOUNT(I) = KOUNT(I) + 1
+                  ICOUNT = KOUNT(I)
+                  RETURN
+            ENDIF
+   30    CONTINUE
+C
+         IF (NMSG.LT.LENTAB) THEN
+C
+C           Empty slot found for new message.
+C
+            NMSG = NMSG + 1
+            LIBTAB(I) = LIB
+            SUBTAB(I) = SUB
+            MESTAB(I) = MES
+            NERTAB(I) = NERR
+            LEVTAB(I) = LEVEL
+            KOUNT (I) = 1
+            ICOUNT    = 1
+         ELSE
+C
+C           Table is full.
+C
+            KOUNTX = KOUNTX+1
+            ICOUNT = 0
+         ENDIF
+      ENDIF
+      RETURN
+C
+C     Formats.
+C
+ 9000 FORMAT ('0          ERROR MESSAGE SUMMARY' /
+     +   ' LIBRARY    SUBROUTINE MESSAGE START             NERR',
+     +   '     LEVEL     COUNT')
+ 9010 FORMAT (1X,A,3X,A,3X,A,3I10)
+ 9020 FORMAT ('0OTHER ERRORS NOT INDIVIDUALLY TABULATED = ', I10)
+ 9030 FORMAT (1X)
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/slatec/xgetua.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/slatec/xgetua.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,51 @@
+*DECK XGETUA
+      SUBROUTINE XGETUA (IUNITA, N)
+C***BEGIN PROLOGUE  XGETUA
+C***PURPOSE  Return unit number(s) to which error messages are being
+C            sent.
+C***LIBRARY   SLATEC (XERROR)
+C***CATEGORY  R3C
+C***TYPE      ALL (XGETUA-A)
+C***KEYWORDS  ERROR, XERROR
+C***AUTHOR  Jones, R. E., (SNLA)
+C***DESCRIPTION
+C
+C     Abstract
+C        XGETUA may be called to determine the unit number or numbers
+C        to which error messages are being sent.
+C        These unit numbers may have been set by a call to XSETUN,
+C        or a call to XSETUA, or may be a default value.
+C
+C     Description of Parameters
+C      --Output--
+C        IUNIT - an array of one to five unit numbers, depending
+C                on the value of N.  A value of zero refers to the
+C                default unit, as defined by the I1MACH machine
+C                constant routine.  Only IUNIT(1),...,IUNIT(N) are
+C                defined by XGETUA.  The values of IUNIT(N+1),...,
+C                IUNIT(5) are not defined (for N .LT. 5) or altered
+C                in any way by XGETUA.
+C        N     - the number of units to which copies of the
+C                error messages are being sent.  N will be in the
+C                range from 1 to 5.
+C
+C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC
+C                 Error-handling Package, SAND82-0800, Sandia
+C                 Laboratories, 1982.
+C***ROUTINES CALLED  J4SAVE
+C***REVISION HISTORY  (YYMMDD)
+C   790801  DATE WRITTEN
+C   861211  REVISION DATE from Version 3.2
+C   891214  Prologue converted to Version 4.0 format.  (BAB)
+C   920501  Reformatted the REFERENCES section.  (WRB)
+C***END PROLOGUE  XGETUA
+      DIMENSION IUNITA(5)
+C***FIRST EXECUTABLE STATEMENT  XGETUA
+      N = J4SAVE(5,0,.FALSE.)
+      DO 30 I=1,N
+         INDEX = I+4
+         IF (I.EQ.1) INDEX = 3
+         IUNITA(I) = J4SAVE(INDEX,0,.FALSE.)
+   30 CONTINUE
+      RETURN
+      END
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/spectrum.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/spectrum.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,79 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Fourier power spectrum
+c   author T. Schreiber (1998) and earlier
+c   modified by H. Kantz 2007
+c=========================================================================== 
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file, fout
+      data h/1./, dh/0./
+      data iverb/1/
+
+      call whatido("Power spectrum by FFT",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      h=fcan("f",h)
+      dh=fcan("w",dh)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_sp")
+         nmaxp=nless(nmax)
+         if(nmaxp.ne.nmax) 
+     .      write(istderr(),*) "spectrum: using first ", nmaxp
+         if(dh.eq.0.) dh=h/nmaxp
+         ibin=nmaxp*dh/(2*h)
+         if(ibin.gt.0) write(istderr(),*) 
+     .      "spectrum: binning", 2*ibin+1," frequencies"
+         call store_spec(nmaxp,x,0)
+         call outfile(fout,iunit,iverb)
+         write(iunit,*) 0., x(1)
+         do 20 i=2+ibin,nmaxp/2+1-ibin,2*ibin+1
+            p=0
+            do 30 ib=i-ibin,i+ibin
+ 30            p=p+x(2*ib-2)
+ 20         write(iunit,*) h*(i-1)/real(nmaxp), p
+            if(iunit.eq.istdout()) write(iunit,*)
+            if(iunit.eq.istdout()) write(iunit,*)
+ 10         if(iunit.ne.istdout()) close(iunit)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-f# -w# -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("f","sampling rate, e.g. in Hz [default 1.]")
+      call popt("w","frequency resolution, e.g. in Hz, [default 1/N]")
+      call popt("l","number of values to be read [all]")
+      call popt("x","number of values to be skipped [0]")
+      call popt("c","column to be read, [1] or file,#")
+      call pout("file_sp")
+      call pall()
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/spikeauto.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/spikeauto.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,81 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   spike train autocorrelation function
+c   author T. Schreiber (1998) based on earlier versions
+c===========================================================================
+      parameter(nx=1000000, nhist=100000)
+      dimension x(nx), lx(nx), ihist(nhist)
+      character*72 file, fout
+      data iverb/1/
+
+      call whatido("spike train autocorrelation function",iverb)
+      bin=fmust("d")
+      totbin=fmust("D")
+      nbin=int(totbin/bin)+1
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      inter=lopt("i",1)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(inter.eq.0) goto 1
+         do 20 n=2,nmax
+ 20         x(n)=x(n)+x(n-1)
+ 1       call sort(nmax,x,lx)
+         do 30 i=1,nbin
+ 30         ihist(i)=0
+         do 40 n1=1,nmax
+            do 50 n2=n1+1,nmax
+               il=int((x(n2)-x(n1))/bin)+1
+               if(il.gt.nbin) goto 40
+ 50            ihist(il)=ihist(il)+1
+ 40         continue
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_sco")
+         call outfile(fout,iunit,iverb)
+         do 60 i=1,nbin
+ 60         write(iunit,*) (i-0.5)*bin, ihist(i)
+ 10      if(iunit.ne.istdout()) close(iunit)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-d# -D# [-i -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("d","time span of one bin")
+      call popt("D","total time spanned")
+      call popt("i","expect intervals rather than times")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_sco")
+      call pall()
+      stop
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/spikespec.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/spikespec.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,105 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   power spectrum of spike trains
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx), lx(nx), sp(nx)
+      character*72 file, fout
+      data iverb/1/
+
+      call whatido("power spectrum of spike trains",iverb)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      fmax=fcan("F",0)
+      nfreq=min(ican("#",0),nx)
+      fres=fcan("w",0)
+      inter=lopt("i",1)
+      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(inter.eq.0) goto 1
+         do 20 n=2,nmax
+ 20         x(n)=x(n)+x(n-1)
+ 1       call sort(nmax,x,lx)
+         if(fmax.le.0.) fmax=2*nmax/(x(nmax)-x(1))
+         if(nfreq.le.0) nfreq=fmax*(x(nmax)-x(1))/2
+         write(istderr(),*) "spikespec: total time covered: ", 
+     .      x(nmax)-x(1)
+         write(istderr(),*) "spikespec: computing ", nfreq, 
+     .      " frequencies up to ", fmax
+         do 30 n=1,nfreq
+            f=(n*fmax)/nfreq
+ 30         sp(n)=sspect(nmax,x,f)
+         ibin=nfreq*fres/2
+         if(ibin.gt.0) write(istderr(),*) 
+     .      "spikespec: binning", 2*ibin+1," frequencies"
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_ss")
+         call outfile(fout,iunit,iverb)
+         do 40 n=1+ibin,nfreq-ibin,2*ibin+1
+            f=(n*fmax)/nfreq
+            p=0
+            do 50 ib=n-ibin,n+ibin
+ 50            p=p+sp(ib)
+ 40         write(iunit,*) f, p
+            if(iunit.eq.istdout()) write(iunit,*)
+            if(iunit.eq.istdout()) write(iunit,*)
+ 10      if(iunit.ne.istdout()) close(iunit)
+      end
+
+      function sspect(nmax,x,f)
+      dimension x(nmax)
+      data pi/3.1415926/
+
+      omega=2*pi*f
+      sr=0
+      si=0
+      do 10 n=1,nmax
+         sr=sr+cos(omega*x(n))
+ 10      si=si+sin(omega*x(n))
+      sspect=sr**2+si**2
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-F# -## -w# -i -o outfile -l# -x# -c# -V# -h] file(s)")
+      call popt("F","maximal frequency [2*l / total time]")
+      call popt("#","number of frequencies [F* total time /2]")
+      call popt("w","frequency resolution [0]")
+      call popt("i","input data: intervals rather than times")
+      call popt("l","number of values to be read [all]")
+      call popt("x","number of values to be skipped [0]")
+      call popt("c","column to be read [1 or file,#]")
+      call pout("file_ss")
+      call pall()
+      stop
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/store_spec.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/store_spec.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,49 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   store data periodogram of x 
+c   if iback.ne.0 transform back to get autocorrelation instead
+C   author Thomas Schreiber (1998)
+c===========================================================================
+      subroutine store_spec(nmax,x,iback)
+      parameter(nx=1000000)
+      dimension x(nmax), w1(nx), w2(nx), iw(15)
+      save w2, iw
+
+      if(nmax.gt.nx) stop "store_spec: make nx larger."
+      call rffti1(nmax,w2,iw)  
+      call rfftf1(nmax,x,w1,w2,iw)
+      do 10 n=1,nmax
+ 10      x(n)=x(n)/real(nmax)
+      x(1)=x(1)**2
+      do 20 n=2,(nmax+1)/2
+         amp=x(2*n-2)**2+x(2*n-1)**2
+         pha=atan2(x(2*n-1),x(2*n-2))
+         x(2*n-2)=amp
+ 20      x(2*n-1)=pha
+      if(mod(nmax,2).eq.0) x(nmax)=x(nmax)**2
+      if(iback.eq.0) return
+      do 30 n=1,nmax
+ 30      x(n)=x(n)*nmax
+      do 40 n=2,(nmax+1)/2
+ 40      x(2*n-1)=0
+      call rfftb1(nmax,x,w1,w2,iw)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/stp.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/stp.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,104 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   space time separation plot
+c   see  H. Kantz, T. Schreiber, Nonlinear Time Series Analysis, Cambridge
+c      University Press (1997,2004)
+c   author T. Schreiber (1998) based on earlier version
+c==========================================================================
+      parameter(nx=1000000,mdt=500,mfrac=100)
+      dimension x(nx), stp(mfrac,mdt)
+      character*72 file, fout
+      data idt/1/, perc/0.05/, ndt/100/
+      data iverb/1/
+
+      call whatido("space-time separation plot",iverb)
+      id=imust("d")
+      m=imust("m")
+      idt=ican("#",idt)
+      ndt=min(ican("t",ndt),mdt)
+      perc=fcan("%",perc)
+      nfrac=min(mfrac,int(1/perc))
+      perc=1./real(nfrac)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+      if(iv_io(iverb).eq.1) write(istderr(),*) "computing ", nfrac, 
+     .   " levels at fractions ", perc, 2*perc, "..."
+
+      call nthstring(1,file)
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      call minmax(nmax,x,xmin,xmax)
+      call stplot(nmax,x,id,m,xmax-xmin,stp,nfrac,ndt,idt)
+      if(isout.eq.1) call addsuff(fout,file,"_stp")
+      call outfile(fout,iunit,iverb)
+      do 10 iper=1,mfrac
+         do 20 it=1,ndt
+ 20         write(iunit,*) it*idt, stp(iper,it)
+ 10      write(iunit,'()')
+      end
+
+      subroutine usage()
+c usage message
+      
+      call whatineed(
+     .   " -d# -m# [-## -t# -%# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("d","delay")
+      call popt("m","embedding dimension")
+      call popt("#","time resolution (1)")
+      call popt("t","time steps (100, <500)")
+      call popt("%","fraction at wich to create levels (0.05, >0.01)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_stp")
+      call pall()
+      stop
+      end
+
+      subroutine stplot(nmax,y,id,m,epsmax,stp,nfrac,mdt,idt)
+      parameter(meps=1000,mfrac=100)
+      dimension y(nmax),stp(mfrac,mdt),ihist(meps)
+
+      do 10 it=1,mdt
+         do 20 ieps=1,meps
+ 20         ihist(ieps)=0
+         do 30 n=it*idt+(m-1)*id+1,nmax
+            dis=0                            ! compute distance in m dimensions
+            do 40 me=0,m-1
+ 40            dis=max(dis,abs(y(n-me*id)-y(n-me*id-it*idt)))
+            ih=min(int(meps*dis/epsmax)+1,meps)
+ 30         ihist(ih)=ihist(ih)+1
+         do 10 ifrac=1,nfrac
+            need=(nmax-it*idt-(m-1)*id)*ifrac/real(nfrac)
+            is=0
+            do 50 ieps=1,meps
+               is=is+ihist(ieps)
+ 50            if(is.ge.need) goto 1
+ 1          stp(ifrac,it)=ieps*epsmax/meps
+ 10      continue
+      end
+
+
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/surrogates.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/surrogates.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,179 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Create multivariate surrogate data
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=100000,mx=20)
+      dimension xx(nx,mx), x(nx,mx), y(nx,mx), xamp(nx,mx), 
+     .   xsort(nx,mx), list(nx), icol(mx), rwork(nx)
+      character*72 file, fout
+      data nsur/1/, imax/-1/
+      external rand
+      data iverb/15/
+
+      call whatido("Create Multivariate Surrogate data",iverb)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      nsur=min(999,ican("n",nsur))
+      imax=ican("i",imax)
+      ispec=lopt("S",1)
+      r=rand(sqrt(abs(fcan("I",0.0))))
+      mcmax=ican("m",0)
+      call columns(mc,mx,icol)
+      if(mcmax.eq.0) mcmax=max(1,mc)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      call xreadfile(nmax,mcmax,nx,xx,nexcl,icol,file,iverb)
+      nmaxp=nless(nmax)
+      if(nmaxp.ne.nmax.and.iv_io(iverb).eq.1) 
+     .   write(istderr(),*) "surrogates: using first ", nmaxp
+      if(file.eq."-") file="stdin"
+      if(isout.eq.1) call addsuff(fout,file,"_surr")
+      if(nsur.gt.1.and.isout.eq.1) call suffix(fout,"_000")
+
+      do 10 isur=1,nsur
+         if(nsur.gt.1.and.isout.eq.1) 
+     .      write(fout(index(fout," ")-3:72),'(i3.3)') isur
+         do 20 m=1,mcmax
+            do 30 n=1,nmaxp
+               x(n,m)=xx(n,m)
+               y(n,m)=x(n,m)
+               xamp(n,m)=x(n,m)
+ 30            xsort(n,m)=x(n,m)
+            call store_spec(nmaxp,xamp(1,m),0)
+            call sort(nmaxp,xsort(1,m),list)
+            do 40 n=1,nmaxp
+ 40            rwork(n)=rand(0.0)
+            call rank(nmaxp,rwork,list)
+ 20         call index2sort(nmaxp,x(1,m),list)
+         it=-1
+         dspec=r1mach(2)
+ 1       it=it+1
+         do 50 m=1,mcmax
+            do 50 n=1,nmaxp
+ 50            y(n,m)=x(n,m)
+         ds0=dspec
+         dspec=toxspec(nmaxp,mcmax,nx,xamp,y)
+         if(imax.ge.0.and.it.ge.imax) goto 2
+         do 60 m=1,mcmax
+ 60         call todist(nmaxp,xsort(1,m),y(1,m),x(1,m))
+         if(dspec.lt.ds0) goto 1
+ 2       continue
+         if(ispec.gt.0) then
+            call xwritefile(nmaxp,mcmax,nx,y,fout,iverb)
+         else
+            call xwritefile(nmaxp,mcmax,nx,x,fout,iverb)
+         endif
+ 10      if(iv_surr(iverb).eq.1) write(istderr(),*) 
+     .      fout(1:index(fout," ")), ' (', it, 
+     .      ' iterations, relative discrepancy ', dspec,   ')'
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-n# -i# -S -I# -o outfile -l# -x# -m# -c#[,#] -V# -h] file")
+      call popt("n","number of surrogates (1)")
+      call popt("i","number of iterations (until no change)")
+      call popt("S","make spectrum exact rather than distribution")
+      call popt("I","seed for random numbers")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("m","number of columns to be read (1)")
+      call popt("c","columns to be read (1)")
+      call pout("file_surr(_nnn)")
+      call pall()
+      call ptext("Verbosity levels (add what you want):")
+      call ptext("          1 = input/output" )
+      call ptext("          2 = iterations / discrepancy")
+      stop
+      end
+
+      function toxspec(nmax,mmax,nxx,a,x)
+      parameter(nx=100000,mx=20,tol=1e-5)
+      dimension x(nxx,mmax), a(nxx,mmax), w(nx,mx), w1(nx), 
+     .   w2(nx), iw(15), goal(mx)
+
+      if(nmax.gt.nx.or.mmax.gt.mx) stop "toxspec: make nx/mx larger."
+      call rffti1(nmax,w2,iw)  
+      do 10 m=1,mmax
+         do 20 n=1,nmax
+ 20         w(n,m)=x(n,m)
+         call rfftf1(nmax,x(1,m),w1,w2,iw)
+         do 30 n=1,nmax
+ 30         x(n,m)=x(n,m)/real(nmax)
+         x(1,m)=sqrt(a(1,m))
+         do 40 n=2,(nmax+1)/2
+            pha=atan2(x(2*n-1,m),x(2*n-2,m))
+            x(2*n-2,m)=sqrt(a(2*n-2,m))
+ 40         x(2*n-1,m)=pha
+ 10      if(mod(nmax,2).eq.0) x(nmax,m)=sqrt(a(nmax,m))
+      if(mmax.gt.1) then
+         do 50 n=2,(nmax+1)/2
+            do 60 m=1,mmax
+ 60            goal(m)=x(2*n-1,m)-a(2*n-1,m)
+            alpha=alp(mmax,goal)
+            do 50 m=1,mmax
+ 50            x(2*n-1,m)=alpha+a(2*n-1,m)
+      endif
+      do 70 m=1,mmax
+         do 80 n=2,(nmax+1)/2
+            c=x(2*n-2,m)*cos(x(2*n-1,m))
+            s=x(2*n-2,m)*sin(x(2*n-1,m))
+            x(2*n-1,m)=s
+ 80         x(2*n-2,m)=c
+ 70      call rfftb1(nmax,x(1,m),w1,w2,iw)
+      toxspec=0
+      do 90 m=1,mmax
+         do 90 n=1,nmax
+ 90         toxspec=toxspec+(x(n,m)-w(n,m))**2
+      toxspec=sqrt((toxspec/nmax)/mmax)
+      end
+
+      function alp(mmax,goal)
+      dimension goal(mmax)
+      data pi/3.1415926/
+
+      f1=0
+      f2=0
+      do 10 m=1,mmax
+         f1=f1+cos(goal(m))
+ 10      f2=f2+sin(goal(m))
+      alp=atan2(f2,f1)
+      scos=0
+      do 20 m=1,mmax
+ 20      scos=scos+cos(alp-goal(m))
+      if(scos.lt.0) alp=alp+pi
+      end
+
+      subroutine todist(nmax,dist,x,y)
+      parameter(nx=100000)
+      dimension x(nmax), dist(nmax), y(nmax), list(nx)
+
+      if(nmax.gt.nx) stop "todist: make nx larger."
+      call rank(nmax,x,list)
+      do 10 n=1,nmax
+ 10      y(n)=dist(list(n))
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/timerev.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/timerev.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,61 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Statistics for time reversibility
+c   author T. Schreiber (1999)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file
+      data iverb/1/
+
+      call whatido("time reversal asymmetry statistic",iverb)
+      id=abs(ican("d",1))
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+c      isout=igetout(fout,iverb)
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         t2=0
+         t3=0
+         do 20 n=id+1,nmax
+            t2=t2+(x(n)-x(n-id))**2
+ 20         t3=t3+(x(n)-x(n-id))**3
+ 10         write(*,*) t3/t2, " "//file(1:index(file," ")-1)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-d# -l# -x# -c# -V# -h] file(s)")
+      call popt("d","delay (1)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pall()
+      stop
+      end
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/tospec.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/tospec.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,53 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Wiener filter x according to spectrum a
+c   (routine needed by surrogates.f)
+C   author Thomas Schreiber (1998)
+c===========================================================================
+      function tospec(nmax,a,x,ibin)
+      parameter(nx=1000000)
+      dimension x(nmax), a(nmax), w(nx), w1(nx), w2(nx), iw(15)
+      save w2, iw
+
+      if(nmax.gt.nx) stop "tospec: make nx larger."
+      do 10 n=1,nmax
+ 10      w(n)=x(n)
+      call rffti1(nmax,w2,iw)  
+      call rfftf1(nmax,x,w1,w2,iw)
+      do 20 n=1,nmax
+ 20      x(n)=x(n)/real(nmax)
+      x(1)=x(1)*(a(1)/x(1)**2)
+      do 30 i=2+ibin,(nmax+1)/2-ibin,2*ibin+1
+         p=0
+         do 40 ib=i-ibin,i+ibin
+ 40         p=p+x(2*ib-2)**2+x(2*ib-1)**2
+         ab=a(2*i-2)/p
+         do 30 ib=i-ibin,i+ibin
+            x(2*ib-2)=x(2*ib-2)*ab
+ 30         x(2*ib-1)=x(2*ib-1)*ab
+      if(mod(nmax,2).eq.0) x(nmax)=x(nmax)*(a(nmax)/x(nmax)**2)
+      call rfftb1(nmax,x,w1,w2,iw)
+      tospec=0
+      do 50 n=1,nmax
+ 50      tospec=tospec+(x(n)-w(n))**2
+      tospec=sqrt(tospec/nmax)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/totospec.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/totospec.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,48 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Force x to have spectrum a (routine needed by surrogates.f)
+C   author Thomas Schreiber (1999)
+c===========================================================================
+      function totospec(nmax,a,x)
+      parameter(nx=1000000)
+      dimension x(nmax), a(nmax), w(nx), w1(nx), w2(nx), iw(15)
+      save w2, iw
+
+      if(nmax.gt.nx) stop "totospec: make nx larger."
+      do 10 n=1,nmax
+ 10      w(n)=x(n)
+      call rffti1(nmax,w2,iw)  
+      call rfftf1(nmax,x,w1,w2,iw)
+      do 20 n=1,nmax
+ 20      x(n)=x(n)/real(nmax)
+      x(1)=sqrt(a(1))
+      do 30 n=2,(nmax+1)/2
+         ab=a(2*n-2)/(x(2*n-2)**2+x(2*n-1)**2)
+         x(2*n-2)=x(2*n-2)*sqrt(ab)
+ 30      x(2*n-1)=x(2*n-1)*sqrt(ab)
+      if(mod(nmax,2).eq.0) x(nmax)=sqrt(a(nmax))
+      call rfftb1(nmax,x,w1,w2,iw)
+      totospec=0
+      do 40 n=1,nmax
+ 40      totospec=totospec+(x(n)-w(n))**2
+      totospec=sqrt(totospec/nmax)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/upo.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/upo.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,268 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   locate unstable periodic points
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000,mper=20)
+      dimension x(nx)
+      character*72 file, fout
+      common /period/ x, nmax, m, eps
+      data frac/0./, iper/1/, teq/-1./, tdis/-1./, tacc/-1./, h/-1./
+      data iverb/1/
+
+      call whatido("locate unstable periodic points",iverb)
+      m=max(imust("m"),1)
+      eps=fcan("r",0.)
+      frac=fcan("v",frac)
+      teq=fcan("w",teq)
+      tdis=fcan("W",tdis)
+      h=fcan("s",h)
+      tacc=fcan("a",tacc)
+      iper=ican("p",iper)
+      nmaxx=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      icen=ican("n",nmaxx)
+      isout=igetout(fout,iverb)
+      if(eps.eq.0.and.frac.eq.0.) call usage()
+
+      do 10 ifi=1,nstrings()
+         call nthstring(ifi,file)
+         nmax=nmaxx
+         call readfile(nmax,x,nexcl,jcol,file,iverb)
+         if(file.eq."-") file="stdin"
+         if(isout.eq.1) call addsuff(fout,file,"_upo_")
+         call rms(nmax,x,sc,sd)
+         if(frac.gt.0) eps=sd*frac
+         if(teq.lt.0.) teq=eps
+         if(tdis.lt.0.) tdis=eps
+         if(tacc.lt.0.) tacc=eps
+         if(h.lt.0.) h=eps
+         if(isout.eq.1) 
+     .      write(fout(index(fout,"_upo_")+5:72),'(i2.2)') iper
+         call outfile(fout,iunit,iverb)
+         call findupo(iper,icen,teq,tdis,tacc,h,iunit,iverb)
+ 10      if(iunit.ne.istdout()) close(iunit)
+      end
+
+      subroutine usage()
+c usage message
+      call whatineed(
+     .   "-m# [-r# | -v#] [-p# -w# -W# -a# -s# -n#"//
+     .   " -o outfile -l# -x# -c# -V# -h] file(s)")
+      call ptext("either -r or -v must be present")
+      call popt("m","embedding dimension")
+      call popt("r","absolute kernel bandwidth")
+      call popt("v","same as fraction of standard deviation")
+      call popt("p","period of orbit (1)")
+      call popt("w","minimal separation of trial points (e)")
+      call popt("W","minimal separation of distinct orbits (e)") 
+      call popt("a",
+     .   "maximal error of orbit to be plotted (all plotted)")
+      call popt("s","initial separation for stability (e)")
+      call popt("n","number of trials (all points)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_upo_pp")
+      call pall()
+      call ptext("Verbosity levels (add what you want):")
+      call ptext("          1 = input/output" )
+      call ptext("          2 = print orbits found")
+      call ptext("          4 = status after 1000 points")
+      call ptext("          8 = status after 100 points")
+      call ptext("         16 = status after 10 points")
+      stop
+      end
+
+      subroutine findupo(iper,icen,teq,tdis,tacc,h,iunit,iverb)
+      parameter(nx=1000000,mper=20)
+      external peri
+      dimension x(nx),xp(mper),fvec(mper),xor(mper,nx),
+     .   iw(mper),w0(mper,mper),w1(mper),w2(mper),w3(mper),
+     .   w4(mper),w5(mper),w6(mper)
+      common /period/ x, nmax, m, eps
+     
+      if(iper.gt.mper) stop "findupo: make mper larger."
+      tol=sqrt(r1mach(4))
+      itry=0
+      ior=0
+      do 10 n=iper,nmax
+         if(iv_10(iverb).eq.1) then
+            if(mod(n,10).eq.0) write(istderr(),'(i7)') n
+         else if(iv_100(iverb).eq.1) then
+            if(mod(n,100).eq.0) write(istderr(),'(i7)') n
+         else if(iv_1000(iverb).eq.1) then
+            if(mod(n,1000).eq.0) write(istderr(),'(i7)') n
+         endif 
+         if(known(n,iper,teq).eq.1) goto 10
+         itry=itry+1
+         if(itry.gt.icen) return
+         do 20 i=1,iper
+ 20         xp(i)=x(n-iper+i)
+         call snls1(peri,1,iper,iper,xp,fvec,w0,mper,tol,tol,0.,
+     .      20*(iper+1),0.,w1,1,100.,0,info,nfev,ndum,iw,w2,w3,w4,w5,w6)
+         err=enorm(iper,fvec)
+         if(info.eq.-1.or.info.eq.5.or.err.gt.tacc) goto 10   ! unsuccessfull
+         if(isold(iper,xp,ior,xor,tdis).eq.1) goto 10         ! already found
+         ior=ior+1                                            ! a new orbit
+         do 30 i=1,iper
+ 30         xor(i,ior)=xp(i)
+         ipor=iperiod(iper,xp,tdis)
+         sor=ipor*stab(iper,xp,h)/real(iper)
+         call print(iper,xp,ipor,sor,err,iunit,iverb)
+ 10      continue
+      end
+
+      function known(n,iper,tol)
+c return 1 if equivalent starting point has been tried
+      parameter(nx=1000000)
+      dimension x(nx)
+      common /period/ x, nmax, m, eps
+
+      known=1
+      do 10 nn=iper,n-1
+         dis=0
+         do 20 i=1,iper
+ 20         dis=dis+(x(n-iper+i)-x(nn-iper+i))**2
+ 10      if(sqrt(dis).lt.tol) return
+      known=0
+      end
+
+      function isold(iper,xp,ior,xor,toler)
+c determine if orbit is in data base
+      parameter(mper=20)
+      dimension xp(iper), xor(mper,*)
+
+      isold=1
+      do 10 ip=1,iper
+         do 20 io=1,ior
+            dor=0
+            do 30 i=1,iper
+ 30            dor=dor+(xp(i)-xor(i,io))**2
+ 20            if(sqrt(dor).le.toler) return
+ 10      call oshift(iper,xp)
+      isold=0
+      end
+  
+      subroutine oshift(iper,xp)
+c leftshift orbit circularly by one position
+      dimension xp(*)
+
+      h=xp(1)
+      do 10 i=1,iper-1
+ 10      xp(i)=xp(i+1)
+      xp(iper)=h
+      end
+ 
+      function iperiod(iper,xp,tol)
+c determine shortest subperiod
+      dimension xp(*)
+
+      do 10 iperiod=1,iper
+         dis=0
+         do 20 i=1,iper
+            il=i-iperiod
+            if(il.le.0) il=il+iper
+ 20         dis=dis+(xp(i)-xp(il))**2
+ 10      if(sqrt(dis).le.tol) return
+      end
+
+      subroutine peri(iflag,mf,iper,xp,fvec,fjac,ldfjac)
+c built discrepancy vector (as called by snls1)
+      dimension xp(*),fvec(*)
+
+      do 10 ip=1,iper
+         fvec(ip)=xp(1)-fc(iper,xp,iflag)
+ 10      call oshift(iper,xp)
+      end
+
+      function fc(iper,xp,iflag)
+c predict (cyclic) point 1, using iper,iper-1...
+      parameter(nx=1000000)
+      dimension  xp(*), x(nx)
+      common /period/ x, nmax, m, eps
+      data cut/20/
+
+      eps2=1./(2*eps*eps)
+      ft=0
+      sw=0
+      fc=0
+      do 10 n=m+1,nmax
+         dis=0
+         do 20 i=1,m
+ 20         dis=dis+(x(n-i)-xp(mod(m*iper-i,iper)+1))**2
+         ddis=dis*eps2
+         w=0
+         if(ddis.lt.cut) w=exp(-ddis)
+         ft=ft+w*x(n)
+ 10      sw=sw+w
+      iflag=-1
+      if(sw.eq.0) return   ! fc undefined, stop minimising
+      fc=ft/sw
+      iflag=1
+      end
+
+      function stab(ilen,xp,h)
+c compute cycle stability by iteration of a tiny perturbation
+      parameter(nx=1000000,mper=20,maxit=1000)
+      dimension xp(*), x(nx), xcop(mper)
+      common /period/ x, nmax, m, eps
+
+      if(mper.lt.ilen) stop "stability: make mper larger."
+      iflag=1
+      stab=0
+      do 10 i=2,m
+ 10      xcop(i)=xp(mod(i-1,ilen)+1)
+      xcop(1)=xp(1)+h
+      do 20 it=1,maxit
+         do 30 itt=1,ilen
+            xx=fc(m,xcop,iflag)
+            if(iflag.eq.-1) goto 1
+            call oshift(m,xcop)
+ 30         xcop(m)=xx
+         dis=0
+         do 40 i=1,m
+ 40         dis=dis+(xcop(i)-xp(mod(i-1,ilen)+1))**2
+         dis=sqrt(dis)
+         stab=stab+log(dis/h)
+         do 20 i=1,m
+ 20         xcop(i)=xp(mod(i-1,ilen)+1)*(1-h/dis) + xcop(i)*h/dis
+ 1    stab=stab/max(it-1,1)
+      end
+
+      subroutine print(iper,xp,ipor,sor,err,iunit,iverb)
+c write orbit to iunit and to stdout
+      dimension xp(*)
+
+      write(iunit,*)
+      write(iunit,*) "period / accuracy / stability"
+      write(iunit,*) ipor, err, exp(sor)
+      do 10 i=1,ipor
+ 10      write(iunit,*) i, xp(i)
+      if(iv_upo(iverb).eq.0) return
+      write(istderr(),*)
+      write(istderr(),*) "period / accuracy / stability"
+      write(istderr(),*) ipor, err, exp(sor)
+      do 20 i=1,ipor
+ 20      write(istderr(),*) i, xp(i)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/upoembed.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/upoembed.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,69 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   delay coordinates for periodic orbits
+C   Copyright (C) Thomas Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000)
+      dimension x(nx)
+      character*72 file, fout
+      data m/2/
+      data iverb/1/
+
+      call whatido("embed using delay coordinates",iverb)
+      id=imust("d")
+      m=ican("m",m)
+      ipp=ican("p",0)
+      isout=igetout(fout,iverb)
+      call nthstring(1,file)
+      call infile(file,iunit,iverb)
+      if(isout.eq.1) call addsuff(fout,file,"_delay")
+      call outfile(fout,iunit2,iverb)
+
+ 1    read(iunit,*,err=1,end=999) ipor, dum1, dum2
+      do 10 ip=1,ipor
+ 10      read(iunit,*,end=999) idum, x(ip)
+      if(ipp.ne.0.and.ipor.ne.ipp) goto 1
+      do 20 ip=1,ipor+1
+ 20      write(iunit2,*) (x(mod(ip-(j-1)*id-1+m*ipor,ipor)+1), j=m,1,-1)
+      write(iunit2,'()')
+      write(iunit2,'()')
+      goto 1
+ 999  continue
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-d# [-m# -p# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("d","delay")
+      call popt("m","embedding dimension (2)")
+      call popt("p","period of orbit (1)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_delay")
+      call pall()
+      stop
+      end
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/verbose.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/verbose.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,98 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   utilities for TISEAN f-sources
+c===========================================================================
+      function igetv(idef)
+c get verbosity level
+
+      igetv=ican("V",-1)
+      if(igetv.eq.-1.and.lopt("V",1).eq.1) igetv=2**15-1
+      if(igetv.eq.-1) igetv=idef
+      end
+
+      function iexv(iverb,item)
+c 1 if verbosity level includes item
+
+      iexv=iand(iverb,item)/item
+      end
+
+c the following functions test for specific numerical verbosity values
+
+      function iv_io(iverb)           ! report i/o activity
+      iv_io=iexv(iverb,1)
+      end
+
+      function iv_echo(iverb)         ! echo first line of data read
+      iv_echo=iexv(iverb,128)
+      end
+
+      function iv_cost(iverb)         ! current value of cost function 
+      iv_cost=iexv(iverb,2)
+      end
+
+      function iv_match(iverb)        ! cost mismatch 
+      iv_match=iexv(iverb,4)
+      end
+
+      function iv_cool(iverb)         ! temperature etc. at cooling 
+      iv_cool=iexv(iverb,8)
+      end
+
+      function iv_vcost(iverb)        ! verbose cost if improved 
+      iv_vcost=iexv(iverb,16)
+      end
+
+      function iv_vmatch(iverb)       ! verbose cost mismatch
+      iv_vmatch=iexv(iverb,32)
+      end
+
+      function iv_10(iverb)           ! upo status after 10 points
+      iv_10=iexv(iverb,16)
+      end
+
+      function iv_100(iverb)          ! upo status after 100 points
+      iv_100=iexv(iverb,8)
+      end
+
+      function iv_1000(iverb)         ! upo status after 1000 points
+      iv_1000=iexv(iverb,4)
+      end
+
+      function iv_upo(iverb)          ! print orbits found
+      iv_upo=iexv(iverb,2)
+      end
+
+      function iv_surr(iverb)         ! print iterations / discrepancy
+      iv_surr=iexv(iverb,2)           
+      end
+
+      function iv_uncorr(iverb)       ! neighbour search status
+      iv_uncorr=iexv(iverb,2)           
+      end
+
+      function iv_clust(iverb)        ! clustering status
+      iv_clust=iexv(iverb,2)           
+      end
+
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/wiener1.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/wiener1.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,85 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Wiener filter (1): write periodogram to file
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx)
+      character*72 file, fout
+      data h/1./, dh/0./
+      data iverb/1/
+
+      call whatido("Wiener filter (first part)",iverb)
+      h=fcan("f",h)
+      dh=fcan("w",dh)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isout=igetout(fout,iverb)
+
+      call nthstring(1,file)
+      if(file.eq."-") stop "wiener1: cannot read stdin"
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      call normal(nmax,x,sc,sd)
+      nmaxp=nmore(nmax)
+      if(nmaxp.ne.nmax) then 
+         write(istderr(),*) "wiener1: padding zeroes to ", nmaxp
+         do 10 n=nmax+1,nmaxp
+ 10         x(n)=0.
+      endif
+      if(isout.eq.1) call addsuff(fout,file,"_amp")
+      call outfile(fout,iunit,iverb)
+      if(dh.eq.0.) dh=h/nmaxp
+      ibin=nmaxp*dh/(2*h)
+      if(ibin.gt.0) write(istderr(),*) 
+     .   "wiener1: binning", 2*ibin+1," frequencies"
+      call store_spec(nmaxp,x,0)
+      write(iunit,*) 0., x(1)
+      do 20 i=2+ibin,(nmaxp+1)/2-ibin,2*ibin+1
+         p=0
+         do 30 ib=i-ibin,i+ibin
+ 30         p=p+x(2*ib-2)
+ 20      write(iunit,*) h*(i-1)/real(nmaxp), p
+      if(mod(nmaxp,2).eq.0)  write(iunit,*) 
+     .   h*(nmaxp-1)/real(nmaxp), x(nmaxp)
+      if(iunit.ne.istdout()) write(istderr(),*)  
+     .   'Now edit periodogram in file ', fout(1:index(fout," ")-1)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-f# -w# -o outfile -l# -x# -c# -V# -h] file")
+      call ptext("then edit file_amp and run: "//
+     .   "wiener2 [-f# -w# -o outfile -l# -x# -c# -V# -h] file")
+      call popt("f","sampling rate (e.g. in Hz, default 1.)")
+      call popt("w","frequency resolution (e.g. in Hz, default 1/N)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call pout("file_amp")
+      call pall()
+      call ptext("Note: ""-"" not accepted as file")
+      write(istderr(),'()') 
+      stop
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/wiener2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/wiener2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,95 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   Wiener filter (2): filter using periodogram in file
+c   author T. Schreiber (1998)
+c===========================================================================
+      parameter(nx=1000000)
+      dimension x(nx), a(nx)
+      character*72 file, fout, ffin
+      data h/1./, dh/0./
+      data iverb/1/
+
+      call whatido("Wiener filter (second part)",iverb)
+      h=fcan("f",h)
+      dh=fcan("w",dh)
+      nmax=ican("l",nx)
+      nexcl=ican("x",0)
+      jcol=ican("c",0)
+      isfin=igetfin(ffin,iverb)
+      isout=igetout(fout,iverb)
+      call nthstring(1,file)
+      if(file.eq."-") stop "wiener2: cannot read stdin"
+      call readfile(nmax,x,nexcl,jcol,file,iverb)
+      call normal(nmax,x,sc,sd)
+      nmaxp=nmore(nmax)
+
+      if(dh.eq.0.) dh=h/nmaxp
+      ibin=nmaxp*dh/(2*h)
+      if(ibin.gt.0) write(istderr(),*) 
+     .   "wiener1: binning", 2*ibin+1," frequencies"
+      if(isout.eq.1) call addsuff(fout,file,"_amp")
+      if(fout.eq." ") fout="-"
+      call infile(fout,iunit,iverb)
+      read(iunit,*) dum, a(1)
+      do 10 i=2+ibin,(nmaxp+1)/2-ibin,2*ibin+1
+ 10      read(iunit,*) dum, a(2*i-2)
+      if(mod(nmaxp,2).eq.0)  read(iunit,*) 
+     .   dum, a(nmaxp)
+      d=tospec(nmaxp,a,x,ibin)
+      if(iv_io(iverb).eq.1) write(istderr(),*) "rms correction: ", d
+      if(isfin.eq.1) call addsuff(ffin,file,"_wc")
+      do 20 n=1,nmax
+ 20      x(n)=x(n)+sc
+      call writefile(nmax,x,ffin,iverb)
+      end
+
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "[-f# -w# -o outfile1 -O outfile -l# -x# -c# -V# -h] file")
+      call ptext("to provide periodogram, first run:"//
+     .   " wiener1 [-f# -w# -o outfile -l# -x# -c# -V# -h] file")
+      call ptext("make sure -f# -w# are the same in both wiener calls")
+      call popt("f","sampling rate (e.g. in Hz, default 1.)")
+      call popt("w","frequency resolution (e.g. in Hz, default 1/N)")
+      call popt("l","number of values to be read (all)")
+      call popt("x","number of values to be skipped (0)")
+      call popt("c","column to be read (1 or file,#)")
+      call popt("o","output file of wiener1, just -o means file_amp")
+      call popt("O","final output file name, just -O means file_wc")
+      call pall()
+      call ptext("Note: ""-"" not accepted as file")
+      write(istderr(),'()') 
+      stop
+      end
+
+      function igetfin(fout,iverb)
+c gets alternate output file name, default " "
+c return 1 if fout must be determined from input file name
+      character*(*) fout
+
+      igetfin=0
+      call stcan("O",fout," ")
+      if(fout.ne." ") return
+      igetfin=lopt("O",1)
+      end
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/xc2.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/xc2.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,244 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c=========================================================================
+c
+c   cross-correlation integral xc2
+c   see  H. Kantz, Phys.Rev.E49, 5091 (1994)
+c
+c   authors: T. Schreiber & H. Kantz (1998)
+c   multivariate version: H. Kantz (Jan 2007)
+c
+c=========================================================================
+c
+      parameter(nx=1000000,me=30,meps=1000,mx=10)
+      dimension x(nx,mx), c(me,meps), eps(meps), mdeps(meps), icol(mx)
+      dimension y(nx,mx)
+      integer mlist(2)
+      character*72 file1, file2, fout
+      data ipmin/1000/, res/2./, eps0/1e-30/, epsm/1e30/, id0/1/
+      data iverb/1/
+
+c=======================================================================
+c assume two input files (file1, file2) 
+c - with identical structure in terms of colums
+c - with identical embedding spaces 
+c - with individual length and exclusions: l, L, x, X
+c - multivariate data: maximum length nx, maximum dimension mx
+c
+c   norm: max-norm 
+c
+c   no rescaling, since xc2 does not make sense if datasets are 
+c                           not used in their original scalings
+c=================================================================
+
+      call whatido("cross correlation sum of two data sets",iverb)
+      id=ican("d",id0)
+      mmax=2
+      mdim=1
+
+      call imcan("M",2,mc,mlist)
+      if (mc.ge.2) then
+       mmax=mlist(2)
+       mdim=mlist(1)
+       if (mmax*mdim.lt.2) stop 'Increase embedding dimension'
+       if (mc.gt.2) print*, 'extra arguments of -m ignored'
+      endif
+
+      ntmin=0
+      ncmin=ican("n",1000)
+      ipmin=ican("N",ipmin)
+      res=fcan("#",res)
+      feps=2**(1./res)
+      eps0=fcan("r",eps0)
+      epsm=fcan("R",epsm)
+      nmaxx=ican("l",nx)
+      nmaxy=ican("L",nx)
+      nexcl1=ican("x",0)
+      nexcl2=ican("X",0)
+
+      call columns(mc,mx,icol)
+
+      if (mc.gt.0.and.mc.ne.mdim) stop 'improper number of columns'
+      isout=igetout(fout,0)
+      if(fout.eq." ") isout=1
+
+      call nthstring(1,file1)
+      if(file1.eq."-") stop "first input file name missing"
+      call xreadfile(nmaxx,mdim,nx,x,nexcl1,icol,file1,iverb)
+      call nthstring(2,file2)
+      if(file2.eq."-") stop "second input file name missing"
+      call xreadfile(nmaxy,mdim,nx,y,nexcl2,icol,file2,iverb)
+
+      if(isout.eq.1) then 
+        call addsuff(fout,file1,"_")
+        call addsuff(fout,fout,file2)
+        call addsuff(fout,fout,"_xc2")
+      endif
+
+      epsmax=0.
+      do imx=1,mmax
+       call minmax(nmaxx,x(1,imx),xmin,xmax)
+       epsmax=1.001*max(xmax-xmin,epsmax)
+      enddo
+      do imx=1,mmax
+       call minmax(nmaxy,y(1,imx),xmin,xmax)
+       epsmax=1.001*max(xmax-xmin,epsmax)
+      enddo
+
+      neps=0
+
+      do 10 epsl=log(min(epsm,epsmax)),log(eps0),-log(feps)
+         neps=neps+1
+         if(neps.gt.meps) stop "xc2: make meps larger"
+         eps(neps)=exp(epsl)
+         do 20 m=1,mmax*mdim
+ 20         c(m,neps)=0
+         if (mdim.eq.1) then
+          call crosscor(nmaxx,x,nmaxy,y,eps(neps)
+     .                 ,id,mmax,c(1,neps),ncmin,ipmin)
+         else
+          call mcrosscor(nmaxx,x,nmaxy,y,eps(neps),
+     .      id,mmax,mdim,c(1,neps),ncmin,ipmin)
+         endif
+         mdd=mmax*mdim
+         mdd1=max(2,mdim)
+         do 30 m=mdd1,mdd
+ 30         if(c(m,neps).eq.0.) goto 1
+         m=mdd+1
+ 1       mdd=m-1
+         if(mdd.eq.mdim-1) stop
+         mdeps(neps)=mdd
+         call outfile(fout,iunit,iverb)
+         do 40 m=mdd1,mdeps(1)
+            write(iunit,'(4h#m= ,i5)') m
+            do 50 nn=1,neps
+               if(mdeps(nn).lt.m) goto 2
+ 50            write(iunit,*) eps(nn), c(m,nn) 
+ 2          write(iunit,'()')
+ 40         write(iunit,'()')
+         close(iunit)
+ 10      write(istderr(),*) eps(neps), mdd, c(mdd,neps)
+      stop
+      end
+c>--------------------------------------------------------------------
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     .   "-M#,# [-d# -n# -N# -## -r# -R#"//
+     .   " -o outfile -l# -x# -L# -X# -c#[,#] -V# -h] file1 file2")
+      call popt("M",
+     ."# of components, maximal embedding dimension [1,2]")
+      call popt("d","delay [1]")
+      call popt("n","minimal number of center points [1000]")
+      call popt("N","maximal number of pairs [1000]")
+      call popt("#","resolution, values per octave [2]")
+      call popt("r",
+     .   "minimal scale to be probed (as long as pairs found)")
+      call popt("R","maximal scale to be probed [xmax-xmin]")
+      call popt("l","length of time series 1 to be read [all data]")
+      call popt("x","# of initial lines of 1 to be skipped [0]")
+      call popt("L","length of time series 2 to be read [all data]")
+      call popt("X","# of initial lines of 2 to be skipped [0]")
+      call popt("c",
+     ."columns to be read [1,2,3,.., # of components]")
+      call pout("file1_file2_xc2")
+      call pall()
+      stop
+      end
+c>--------------------------------------------------------------------
+      subroutine crosscor(nmaxx,x,nmaxy,y,eps,id,m,c,ncmin,ipmin)
+      parameter(im=100,ii=100000000,nx=1000000,mm=30)
+      dimension y(nmaxy),x(nmaxx)
+      dimension jh(0:im*im),ipairs(mm),c(m),jpntr(nx),nlist(nx)
+
+      if(nmaxx.gt.nx.or.m.gt.mm) stop "crosscor: make mm/nx larger."
+      if(nmaxy.gt.nx.or.m.gt.mm) stop "crosscor: make mm/nx larger."
+
+      do 10 i=1,m-1
+ 10      ipairs(i)=0
+      mb=min(m,2)
+      call base(nmaxx,x,id,mb,jh,jpntr,eps)
+      do 20 n=(m-1)*id+1,nmaxy
+         call neigh(nx,y,x,n,nmaxx,id,mb,jh,jpntr,eps,nlist,nfound)
+         do 30 nn=1,nfound                   ! all neighbours in two dimensions
+            np=nlist(nn)
+            if(np.lt.(m-1)*id+1) goto 30
+            ipairs(1)=ipairs(1)+1
+            do 40 i=mb,m-1
+               if(abs(y(n-i*id)-x(np-i*id)).ge.eps) goto 30
+ 40            ipairs(i)=ipairs(i)+1            ! neighbours in 3..m dimensions
+ 30         continue
+ 20      if(n-(m-1)*id.ge.ncmin.and.ipairs(m-1).ge.ipmin) goto 1
+      n=n-1
+ 1    s=real(n-(m-1)*id)*real(nmaxx-(m-1)*id) ! normalisation
+      do 50 i=1,m-1
+ 50      if(s.gt.0.) c(i+1)=ipairs(i)/s
+      end
+c>--------------------------------------------------------------------
+      subroutine mcrosscor(nmaxx,x,nmaxy,y,eps,id,m,mdim,c,ncmin,ipmin)
+
+      parameter(im=100,nx=1000000,mm=30,mx=10)
+
+      dimension y(nx,mx),x(nx,mx)
+      dimension jh(0:im*im),ipairs(mm),c(m*mdim),jpntr(nx),nlist(nx)
+      dimension vx(mm)
+
+      if(nmaxx.gt.nx.or.m.gt.mm) stop "mcrosscor: make mm/nx larger."
+      if(nmaxy.gt.nx.or.m.gt.mm) stop "mcrosscor: make mm/nx larger."
+
+      if (m*mdim.gt.mm) stop 'embedding x spatial dimension < 30 !'
+      do 10 i=1,m*mdim
+ 10      ipairs(i)=0
+
+      call mbase(nmaxy,mdim,nx,y,id,1,jh,jpntr,eps)
+      do 20 n=(m-1)*id+1,nmaxx
+         do ii=1,mdim
+          vx(ii)=x(n,ii)
+         enddo
+         call mneigh2(nmaxy,mdim,y,nx,vx,jh,jpntr,eps,nlist,nfound)
+         do 30 nn=1,nfound               ! all neighbours in mdim dimensions
+            np=nlist(nn)
+            if(np.lt.(m-1)*id+1) goto 30
+            ipairs(mdim)=ipairs(mdim)+1
+            do 40 i=1,m-1
+             do 41 iim=1,mdim
+               if(abs(x(n-i*id,iim)-y(np-i*id,iim)).ge.eps) goto 30
+               idim=i*mdim+iim
+               ipairs(idim)=ipairs(idim)+1  ! neighbours mdim+1..m dimensions
+ 41           continue
+ 40          continue
+ 30         continue
+ 20      if(n-(m-1)*id.ge.ncmin.and.ipairs(m*mdim).ge.ipmin) goto 1
+      n=n-1
+ 1    s=real(n-(m-1)*id)*real(nmaxy-(m-1)*id) ! normalisation
+      do 50 i=mdim,mdim*m
+ 50      if(s.gt.0.) c(i)=ipairs(i)/s
+
+      return
+      end
+c>---------------------------------------------------------------------
+
+
+
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/xreadfile.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/xreadfile.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,103 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c   multivariate i/o utilities for TISEAN f-sources
+c   author T. Schreiber (1999)
+c===========================================================================
+      subroutine xreadfile(nmax,mmax,nx,x,nexcl,icol,file,iverb)
+c read columns as seperate time series
+      parameter(mline=1000)
+      dimension x(nx,mmax), icol(mmax), dum(mline)
+      character*(*) file
+
+      iv=iv_io(iverb)
+      if(iv.ne.0) write(istderr(),*) 
+     .   'reading from columns', (icol(i),i=1,mmax)
+      call infile(file,iunit,iverb)
+      mlast=0
+      do 10 i=1,mmax
+ 10      mlast=max(mlast,icol(i))
+      if(mlast.gt.mline) stop "xreadfile: make mline larger."
+      lc=0
+      do 20 n=1,nexcl
+         lc=lc+1
+ 20      read(iunit,*,end=999)
+      do 30 n=1,nmax
+ 1       lc=lc+1
+         read(iunit,*,err=2,end=999)  (dum(i),i=1,mlast)
+         do 40 i=1,mmax
+ 40         x(n,i)=dum(icol(i))
+         goto 30
+ 2       if(iv.ne.0) write(istderr(),*) "data in line ", lc, " ignored"
+         goto 1
+ 30      continue
+      if(iv.ne.0) write(istderr(),*) '*** readfile: warning:'//
+     .   ' maybe not the whole file has been used'
+ 999  nmax=n-1
+      if(iunit.ne.istdin()) close(iunit)
+      if(iv.ne.0) call readreport(nmax,file)
+      end
+
+      subroutine xwritecfile(nmax,mmax,nx,x,file,iverb,comm)
+c write comment and nmax points
+      dimension x(nx,mmax)
+      character*(*) file,comm
+
+      if(mmax.gt.1000) then
+         write(istderr(),*) "xwritecfile: "//
+     .      "cannot write more than 1000 columns"
+         stop
+      endif
+      call outfile(file,iunit,iverb)
+      if(comm.ne." ") write(iunit,'(a)') comm
+      do 10 n=1,nmax
+ 10      write(iunit,'(1000g16.7)') (x(n,i),i=1,mmax)
+      if(iunit.eq.istdout()) then
+         write(iunit,*)
+         write(iunit,*)
+      else
+         close(iunit)
+      endif
+      if(iv_io(iverb).eq.1) call writereport(nmax,file)
+      end
+
+      subroutine xwritefile(nmax,mmax,nx,x,file,iverb)
+c write nmax points
+      dimension x(nx,mmax)
+      character*(*) file
+
+      call xwritecfile(nmax,mmax,nx,x,file,iverb," ")
+      end
+
+      subroutine columns(mc,mmax,icol)
+      dimension icol(*)
+
+      call imcan("c",mmax,mc,icol)
+      icmax=0
+      do 10 m=1,mc
+ 10      icmax=max(icmax,icol(m))
+      do 20 m=mc+1,mmax
+         icmax=icmax+1
+ 20      icol(m)=icmax
+      end
+
+
+
diff -r 0ed233a0d08c -r 82ff20b4d849 main/system-identification/devel/tisean/source_f/xrecur.f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/system-identification/devel/tisean/source_f/xrecur.f	Wed Mar 28 13:32:37 2012 +0000
@@ -0,0 +1,402 @@
+c===========================================================================
+c
+c   This file is part of TISEAN
+c 
+c   Copyright (c) 1998-2007 Rainer Hegger, Holger Kantz, Thomas Schreiber
+c 
+c   TISEAN is free software; you can redistribute it and/or modify
+c   it under the terms of the GNU General Public License as published by
+c   the Free Software Foundation; either version 2 of the License, or
+c   (at your option) any later version.
+c
+c   TISEAN is distributed in the hope that it will be useful,
+c   but WITHOUT ANY WARRANTY; without even the implied warranty of
+c   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+c   GNU General Public License for more details.
+c
+c   You should have received a copy of the GNU General Public License
+c   along with TISEAN; if not, write to the Free Software
+c   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+c
+c===========================================================================
+c cross-recurrence plot
+c authors H. Kantz & T. Schreiber (2004)
+c modified by H. Kantz Feb 2007 (multivariate version)
+      program xrecur
+      parameter(nx=1000000,me=30,meps=1000,mx=10,nx1=10000000)
+      dimension x(nx,mx), y(nx,mx)
+      dimension x1(nx1),y1(nx1)
+      integer mlist(2), inot(nx1), icol(mx)
+      character*72 file1, file2, fout
+      data eps/1e-3/, id0/1/
+      data iverb/1/, xperc/100./
+
+      call whatido(
+     ."cross recurrence plot of two scalar or vector valued data sets"
+     .             ,iverb)
+
+c ================================================================
+c assume two input files (file1, file2) 
+c - with identical structure in terms of colums
+c - with identical embedding spaces 
+c - with individual length and exclusions: l1,l2, x1,x2
+c - univariate data: maximum time series length nx1
+c - multivariate data: maximum length nx, maximum dimension mx
+c
+c either: fixed epsilon, plot certain percentage of all 
+c         neighbours found
+c or:     fix the numbers of points of the y time series to be 
+c         found as neighbours of the x time series: non-symmetric! 
+c norm: max-norm after rescaling of the individual components
+c       unless rescaling is switched off
+c
+c=================================================================
+
+      id=ican("d",id0)
+
+      mmax=2
+      mdim=1
+
+      call imcan("m",2,mc,mlist)
+      if (mc.ge.2) then
+       mmax=mlist(2)
+       mdim=mlist(1)
+       if (mc.gt.2) print*,'extra arguments of -m ignored'
+      endif
+      ntmin=0
+      kmin=ican("k",0)
+      idown1=ican("s",1)
+      idown2=ican("S",1)
+      eps=fcan("r",eps)
+      xperc=fcan("%",xperc)
+      nmaxx=ican("l",nx)
+      nmaxy=ican("L",nx)
+      nexcl1=ican("x",0)
+      nexcl2=ican("X",0)
+      iscal=0
+      iscal=lopt("n",1)
+
+      call columns(mc,mx,icol)
+      if (mc.gt.0.and.mc.ne.mdim) stop 'improper number of columns'
+      isout=igetout(fout,0)
+      if(fout.eq." ") isout=1
+c     
+      call nthstring(1,file1)
+      if(file1.eq."-") stop 'missing input filename'
+      if (mdim.gt.1) 
+     .  call xreadfile(nmaxx,mdim,nx,x,nexcl1,icol,file1,iverb)
+      if (mdim.eq.1) 
+     .  call xreadfile(nmaxx,1,nx1,x1,nexcl1,icol,file1,iverb)
+c     
+      call nthstring(2,file2)
+      if(file2.eq."-") stop 'missing second input filename'
+      if (mdim.gt.1) 
+     . call xreadfile(nmaxy,mdim,nx,y,nexcl2,icol,file2,iverb)
+      if (mdim.eq.1) 
+     . call xreadfile(nmaxy,1,nx1,y1,nexcl2,icol,file2,iverb)
+
+      if(isout.eq.1) then 
+        call addsuff(fout,file1,"_")
+        call addsuff(fout,fout,file2)
+        call addsuff(fout,fout,"_xrec")
+      endif
+
+c     rescale data if flag -n is not set (iscal=1)
+      if (iscal.ne.1) then 
+       print*,'normalizing data to unit interval'
+
+       if (mdim.gt.1) then
+
+c      rescaling each component of file 1
+        do imx=1,mdim
+         xmin=x(1,imx)
+         xmax=x(1,imx)
+         do i1=2,nmaxx
+          xmax=max(xmax,x(i1,imx))
+          xmin=min(xmin,x(i1,imx))
+         enddo
+         scal=.9999d0/(xmax-xmin)
+         do i1=1,nmaxx
+          x(i1,imx)=(x(i1,imx)-xmin)*scal
+         enddo
+        enddo
+
+c     rescaling each component of file 2
+
+        do imx=1,mdim
+         xmin=y(1,imx)
+         xmax=y(1,imx)
+         do i1=2,nmaxy
+          xmax=max(xmax,y(i1,imx))
+          xmin=min(xmin,y(i1,imx))
+         enddo
+         scal=.9999d0/(xmax-xmin)
+         do i1=1,nmaxy
+          y(i1,imx)=(y(i1,imx)-xmin)*scal
+         enddo
+        enddo
+
+       else
+
+c     rescaling the single component of file 1
+         xmin=x1(1)
+         xmax=x1(1)
+         do i1=2,nmaxx
+          xmax=max(xmax,x1(i1))
+          xmin=min(xmin,x1(i1))
+         enddo
+         scal=.9999d0/(xmax-xmin)
+         do i1=1,nmaxx
+          x1(i1)=(x1(i1)-xmin)*scal
+         enddo
+
+c     rescaling the single component of file 2
+
+         xmin=y1(1)
+         xmax=y1(1)
+         do i1=2,nmaxy
+          xmax=max(xmax,y1(i1))
+          xmin=min(xmin,y1(i1))
+         enddo
+         scal=.9999d0/(xmax-xmin)
+         do i1=1,nmaxy
+          y1(i1)=(y1(i1)-xmin)*scal
+         enddo
+
+       endif
+      endif
+
+      call outfile(fout,iunit,1)
+      ntot=0
+
+      if (kmin.eq.0) then
+c     search all neighbours with distance < eps
+
+        xperc=xperc/100.
+
+        if (mdim.eq.1) then
+          call crossrec(nmaxx,x1,nmaxy,y1,eps,
+     .                   id,mmax,iunit,xperc,ntot,idown1,idown2)
+         else
+          call mcrossrec(nmaxx,x,nmaxy,y,eps,
+     .              id,mmax,mdim,iunit,xperc,ntot,idown1,idown2)
+        endif
+
+c>-----------------------------------------------------------
+      else 
+
+       do i=(mmax-1)*id+1,nmaxx
+        inot(i)=1
+       enddo
+       epsfac=1.1
+       eps=eps/epsfac
+
+       do 10 io=1,100
+         eps=eps*epsfac
+         if (mdim.eq.1) then
+          call crossrec1(nmaxx,x1,nmaxy,y1,eps,
+     .               id,mmax,kmin,iunit,inot,ntodo,ntot,idown1,idown2)
+         else
+          call mcrossrec1(nmaxx,x,nmaxy,y,eps,id,mmax,mdim,kmin,iunit,
+     .                    inot,ntodo,ntot,idown1,idown2)
+         endif
+         if (iverb.eq.1) print*,eps,ntodo,ntot
+         if (ntodo.eq.0) goto 7
+ 10    continue
+c>--------------------------------------------------------
+      endif
+
+ 7    close(iunit)
+      print*,ntot,' points contained in the recurrence plot'
+      if (kmin.gt.0) print*,'last epsilon:',eps
+      if (kmin.gt.0) print*,'average number of neighbours:',
+     .                      real(ntot)*idown1/nmaxx
+      if (kmin.eq.0) print*,'using eps=',eps
+      end
+c========================================================
+      subroutine usage()
+c usage message
+
+      call whatineed(
+     ."[ -m#,# -d# -r# -k# -o outfile -l# -x# -L# -X# -c#[,#] -%# -V# 
+     . -n -h] file1 file2")
+      call popt("m","# of components, embedding dimension [1,2]")
+      call popt("c","columns to be read [1,2,3,...,# of components]")
+      call popt("d","delay [1]")
+      call popt("r",
+     ."diameter of the neighbourhood as absolute value [.001]")
+      call popt("k",
+     ."find the # closest points, starting with diameter r")
+      call popt("%",
+     ."print only percentage of dots [100], no effect if -k is set")
+      call popt("l","length of time series 1 to be read [all data]")
+      call popt("x","# of initial lines in 1 to be skipped [0]")
+      call popt("s","use only every # delay vector of file 1 [1]")
+      call popt("L","length of time series 2 to be read [all data]")
+      call popt("X","# of initial lines in 2 to be skipped [0]")
+      call popt("S","use only every # delay vector of file 2 [1]")
+      call popt("n","if set: do NOT normalize data to unit interval")
+      call pout("file1_file2_xrec")
+      call pall()
+      stop
+      end
+c>--------------------------------------------------------------------
+      subroutine crossrec(nmaxx,x,nmaxy,y,eps,
+     .                    id,m,iunit,xperc,ntot,idown1,idown2)
+      parameter(im=100,ii=100000000,nx=1000000)
+      dimension y(nx),x(nx)
+      dimension jh(0:im*im),jpntr(nx),nlist(nx)
+      nseed=13413241
+
+      if(nmaxx.gt.nx.or.nmaxy.gt.nx) stop "crossrec: make nx larger."
+      mb=min(m,2)
+
+      call base(nmaxy,y,id,mb,jh,jpntr,eps)
+      nnull=(m-1)*id+1
+      do 20 n=nnull,nmaxx,idown1
+         call neigh(nx,x,y,n,nx,id,mb,jh,jpntr,eps,nlist,nfound)
+         do 30 nn=1,nfound                   ! all neighbours in two dimensions
+            np=nlist(nn)
+            if (np.lt.nnull) goto 30
+            if (mod(np-nnull,idown2).ne.0) goto 30
+            do 40 i=mb,m-1
+               if(abs(x(n-i*id)-y(np-i*id)).ge.eps) goto 30
+ 40         continue
+            call random(nseed,rr)
+            if (rr.le.xperc) write(iunit,*)n,np
+            if (rr.le.xperc) ntot=ntot+1
+ 30         continue
+ 20      continue
+      end
+c>--------------------------------------------------------------------
+      subroutine mcrossrec(nmaxx,x,nmaxy,y,eps,
+     .                id,m,mdim,iunit,xperc,ntot,idown1,idown2)
+      parameter(im=100,nx=1000000,mx=10)
+      dimension y(nx,mx),x(nx,mx)
+      dimension jh(0:im*im),jpntr(nx),nlist(nx)
+      dimension vx(mx)
+      nseed=134512331
+
+      if(nmaxx.gt.nx.or.nmaxy.gt.nx) stop "mcrossrec: make nx larger."
+
+      call mbase(nmaxy,mdim,nx,y,id,1,jh,jpntr,eps)
+      nnull=(m-1)*id+1
+      do 20 n=nnull,nmaxx,idown1
+         do ii=1,mdim
+          vx(ii)=x(n,ii)
+         enddo
+         call mneigh2(nmaxy,mdim,y,nx,vx,jh,jpntr,eps,nlist,nfound)
+         do 30 nn=1,nfound               ! all neighbours in mdim dimensions
+            np=nlist(nn)
+            if (np.lt.nnull) goto 30
+            if (mod(np-nnull,idown2).ne.0) goto 30
+            do 40 i=1,m-1
+             do 41 iim=1,mdim
+               if(abs(x(n-i*id,iim)-y(np-i*id,iim)).ge.eps) goto 30
+ 41          continue
+ 40         continue
+             call random(nseed,rr)
+             if (rr.le.xperc) write(iunit,*)n,np
+             if (rr.le.xperc) ntot=ntot+1
+ 30      continue
+ 20   continue
+      return
+      end
+
+      subroutine crossrec1(nmaxx,x,nmaxy,y,eps,id,m,kmin,iunit,
+     .                     inot,ntodo,ntot,idown1,idown2)
+      parameter(im=100,ii=100000000,nx=1000000)
+      dimension y(nmaxy),x(nmaxx),inot(nmaxx)
+      dimension jh(0:im*im),jpntr(nx),nlist(nx)
+      ntodo=0
+
+      if(nmaxx.gt.nx.or.nmaxy.gt.nx) stop "crossrec1: make nx larger."
+      mb=min(m,2)
+
+      call base(nmaxy,y,id,mb,jh,jpntr,eps)
+      nnull=(m-1)*id+1
+      do 20 n=nnull,nmaxx,idown1
+         if (inot(n).eq.0) goto 20
+         ntodo=ntodo+1
+         call neigh(nx,x,y,n,nx,id,mb,jh,jpntr,eps,nlist,nfound)
+         if (nfound.lt.kmin) goto 20
+         nreal=0
+         do 30 nn=1,nfound                   ! all neighbours in two dimensions
+            np=nlist(nn)
+            if(np.lt.nnull) goto 30
+            if (mod(np-nnull,idown2).ne.0) goto 30
+            do 40 i=mb,m-1
+               if(abs(x(n-i*id)-y(np-i*id)).ge.eps) goto 30
+ 40         continue
+            nreal=nreal+1
+            nlist(nreal)=np
+ 30      continue
+         if (nreal.lt.kmin) goto 20
+           ntodo=ntodo-1
+           inot(n)=0
+           ntot=ntot+nreal
+           do in=1,nreal
+            write(iunit,*)n,nlist(in)
+           enddo
+ 20      continue
+      end
+c>--------------------------------------------------------------------
+      subroutine mcrossrec1(nmaxx,x,nmaxy,y,eps,
+     .                      id,m,mdim,kmin,iunit,inot,
+     .                      ntodo,ntot,idown1,idown2)
+      parameter(im=100,nx=1000000,mx=10)
+      dimension y(nx,mx),x(nx,mx),inot(nmaxx)
+      dimension jh(0:im*im),jpntr(nx),nlist(nx)
+      dimension vx(mx)
+      ntodo=0
+
+      if(nmaxx.gt.nx.or.nmaxy.gt.nx) stop "mcrossrec1: make nx larger."
+
+      call mbase(nmaxy,mdim,nx,y,id,1,jh,jpntr,eps)
+      nnull=(m-1)*id+1
+      do 20 n=nnull,nmaxx,idown1
+         if (inot(n).eq.0) goto 20
+         ntodo=ntodo+1
+         do ii=1,mdim
+          vx(ii)=x(n,ii)
+         enddo
+         call mneigh2(nmaxy,mdim,y,nx,vx,jh,jpntr,eps,nlist,nfound)
+         if (nfound.lt.kmin) goto 20
+         nreal=0
+         do 30 nn=1,nfound               ! all neighbours in mdim dimensions
+            np=nlist(nn)
+            if(np.lt.nnull) goto 30
+            if (mod(np-nnull,idown2).ne.0) goto 30
+            do 40 i=0,m-1
+             do 41 iim=1,mdim
+               if(abs(x(n-i*id,iim)-y(np-i*id,iim)).ge.eps) goto 30
+ 41          continue
+ 40         continue
+            nreal=nreal+1
+            nlist(nreal)=np 
+ 30      continue
+         if (nreal.lt.kmin) goto 20
+           inot(n)=0
+           ntot=ntot+nreal
+           do in=1,nreal
+            write(iunit,*)n,nlist(in)
+           enddo
+           ntodo=ntodo-1
+ 20      continue
+      return
+      end
+
+      subroutine random(iseed,s)
+c
+c     random number generator of Park & Miller
+      integer*8 ifac,ibase,iargument
+      ifac=7**5
+      ibase=2**30-1
+      im=im+2**30
+      iargument=iseed
+      iargument=mod(iargument*ifac,ibase)
+      s=float(iargument)/float(ibase)
+      iseed=iargument
+      return
+      end
+c>------------------------------------