/* specfunc/test_gamma.c
 *
 * Copyright (C) 2007 Brian Gough
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 3 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

/* Author:  G. Jungman */

#include <config.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_sf.h>
#include "test_sf.h"

int test_gamma(void)
{
  gsl_sf_result r;
  gsl_sf_result r1, r2;
  double sgn;
  int s = 0;

  TEST_SF(s,  gsl_sf_lngamma_e, (-0.1, &r), 2.368961332728788655 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (-1.0/256.0, &r), 5.547444766967471595  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (1.0e-08, &r), 18.420680738180208905 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (0.1, &r), 2.252712651734205 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (1.0 + 1.0/256.0, &r), -0.0022422226599611501448 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (2.0 + 1.0/256.0, &r), 0.0016564177556961728692 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (100.0, &r), 359.1342053695753 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (-1.0-1.0/65536.0, &r), 11.090348438090047844 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (-1.0-1.0/268435456.0, &r), 19.408121054103474300 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (-100.5, &r), -364.9009683094273518 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lngamma_e, (-100-1.0/65536.0, &r), -352.6490910117097874 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (0.7, &r, &sgn), 0.26086724653166651439, TEST_TOL1, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (0.1, &r, &sgn), 2.2527126517342059599, TEST_TOL0, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-0.1, &r, &sgn), 2.368961332728788655, TEST_TOL0, -1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-1.0-1.0/65536.0, &r, &sgn), 11.090348438090047844, TEST_TOL0, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-2.0-1.0/256.0, &r, &sgn), 4.848447725860607213, TEST_TOL0, -1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-2.0-1.0/65536.0, &r, &sgn), 10.397193628164674967, TEST_TOL0, -1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-3.0-1.0/8.0, &r, &sgn), 0.15431112768404182427, TEST_TOL2, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lngamma_sgn_e, (-100.5, &r, &sgn), -364.9009683094273518, TEST_TOL0, -1.0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gamma_e, (1.0 + 1.0/4096.0, &r), 0.9998591371459403421 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (1.0 + 1.0/32.0, &r), 0.9829010992836269148 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (2.0 + 1.0/256.0, &r), 1.0016577903733583299 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (9.0, &r), 40320.0                   , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (10.0, &r), 362880.0                  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (100.0, &r), 9.332621544394415268e+155 , TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (170.0, &r), 4.269068009004705275e+304 , TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (171.0, &r), 7.257415615307998967e+306 , TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (-10.5, &r), -2.640121820547716316e-07  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gamma_e, (-11.25, &r), 6.027393816261931672e-08  , TEST_TOL0, GSL_SUCCESS); /* exp()... not my fault */
  TEST_SF(s,  gsl_sf_gamma_e, (-1.0+1.0/65536.0, &r), -65536.42280587818970 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gammastar_e, (1.0e-08, &r), 3989.423555759890865  , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (1.0e-05, &r), 126.17168469882690233 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (0.001, &r), 12.708492464364073506 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (1.5, &r), 1.0563442442685598666 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (3.0, &r), 1.0280645179187893045 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (9.0, &r), 1.0092984264218189715 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (11.0, &r), 1.0076024283104962850 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (100.0, &r), 1.0008336778720121418 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (1.0e+05, &r), 1.0000008333336805529 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammastar_e, (1.0e+20, &r), 1.0 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gammainv_e, (1.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (2.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (3.0, &r), 0.5, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (4.0, &r), 1.0/6.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gammainv_e, (10.0, &r), 1.0/362880.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (100.0, &r), 1.0715102881254669232e-156, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gammainv_e, (0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-1.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-2.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-3.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-4.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_gammainv_e, (-10.5, &r), -1.0/2.640121820547716316e-07, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-11.25, &r), 1.0/6.027393816261931672e-08, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_gammainv_e, (-1.0+1.0/65536.0, &r), -1.0/65536.42280587818970 , TEST_TOL1, GSL_SUCCESS);

  TEST_SF_2(s, gsl_sf_lngamma_complex_e, (5.0, 2.0, &r1, &r2),
            2.7487017561338026749, TEST_TOL0,
            3.0738434100497007915, TEST_TOL0,
            GSL_SUCCESS);

  TEST_SF_2(s, gsl_sf_lngamma_complex_e, (100.0, 100.0, &r1, &r2),
            315.07804459949331323, TEST_TOL1,
            2.0821801804113110099, TEST_TOL3,
            GSL_SUCCESS);

  TEST_SF_2(s, gsl_sf_lngamma_complex_e, (100.0, -1000.0, &r1, &r2),
            -882.3920483010362817000, TEST_TOL1,
            -2.1169293725678813270, TEST_TOL3,
            GSL_SUCCESS);

  TEST_SF_2(s, gsl_sf_lngamma_complex_e, (-100.0, -1.0, &r1, &r2),
            -365.0362469529239516000, TEST_TOL1,
            -3.0393820262864361140, TEST_TOL1,
            GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_taylorcoeff_e, (10,   1.0/1048576.0, &r), 1.7148961854776073928e-67  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (10,   1.0/1024.0, &r), 2.1738891788497900281e-37  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (10,   1.0, &r), 2.7557319223985890653e-07  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (10,   5.0, &r), 2.6911444554673721340      , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (10,   500.0, &r), 2.6911444554673721340e+20  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (100,  100.0, &r), 1.0715102881254669232e+42  , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (1000, 200.0, &r), 2.6628790558154746898e-267 , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_taylorcoeff_e, (1000, 500.0, &r), 2.3193170139740855074e+131 , TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s,   gsl_sf_fact_e, (0, &r), 1.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,   gsl_sf_fact_e, (1, &r), 1.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,   gsl_sf_fact_e, (7, &r), 5040.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_fact_e, (33, &r), 8.683317618811886496e+36 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,   gsl_sf_doublefact_e, (0, &r), 1.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,   gsl_sf_doublefact_e, (1, &r), 1.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,   gsl_sf_doublefact_e, (7, &r), 105.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_doublefact_e, (33, &r), 6.332659870762850625e+18 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_lnfact_e, (0, &r), 0.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnfact_e, (1, &r), 0.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnfact_e, (7, &r), 8.525161361065414300 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnfact_e, (33, &r), 85.05446701758151741 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_lndoublefact_e, (0, &r), 0.0  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lndoublefact_e, (7, &r), 4.653960350157523371  , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lndoublefact_e, (33, &r), 43.292252022541719660 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lndoublefact_e, (34, &r), 45.288575519655959140 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lndoublefact_e, (1034, &r), 3075.6383796271197707 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lndoublefact_e, (1035, &r), 3078.8839081731809169 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_lnchoose_e, (7,3, &r), 3.555348061489413680 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnchoose_e, (5,2, &r), 2.302585092994045684 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_choose_e, (7,3, &r), 35.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_choose_e, (7,4, &r), 35.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_choose_e, (5,2, &r), 10.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_choose_e, (5,3, &r), 10.0 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_choose_e, (500,495, &r), 255244687600.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_choose_e, (500,5, &r), 255244687600.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_choose_e, (500,200, &r), 5.054949849935532221e+144 , TEST_TOL5, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_choose_e, (500,300, &r), 5.054949849935532221e+144 , TEST_TOL5, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_lnpoch_e, (5, 0.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnpoch_e, (5, 1.0/65536.0, &r), 0.000022981557571259389129, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnpoch_e, (5, 1.0/256.0, &r),   0.005884960217985189004,    TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnpoch_e, (7,3, &r), 6.222576268071368616, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_lnpoch_e, (5,2, &r), 3.401197381662155375, TEST_TOL0, GSL_SUCCESS);

  TEST_SF_SGN(s, gsl_sf_lnpoch_sgn_e, (5.0, 0.0, &r, &sgn), 0.0, TEST_TOL1, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lnpoch_sgn_e, (-4.5, 0.25, &r, &sgn), 0.7430116475119920117, TEST_TOL1, 1.0, GSL_SUCCESS);
  TEST_SF_SGN(s, gsl_sf_lnpoch_sgn_e, (-4.5, 1.25, &r, &sgn), 2.1899306304483174731, TEST_TOL1, -1.0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_poch_e, (5, 0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (7,3, &r), 504.0 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (5,2, &r), 30.0  , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (5,1.0/256.0, &r), 1.0059023106151364982 , TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_pochrel_e, (5,0, &r), 1.506117668431800472, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (7,3, &r), 503.0/3.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (5,2, &r), 29.0/2.0, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (5,0.01, &r), 1.5186393661368275330, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (-5.5,0.01, &r), 1.8584945633829063516, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (-5.5,-1.0/8.0, &r), 1.0883319303552135488, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (-5.5,-1.0/256.0, &r), 1.7678268037726177453, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_pochrel_e, (-5.5,-11.0, &r), 0.09090909090939652475, TEST_TOL0, GSL_SUCCESS);

  /* Add tests for special cases with negative arguments */
  TEST_SF(s,  gsl_sf_poch_e, (-9.0, -4.0, &r), 1.0/17160.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-9.0, -3.0, &r), -1.0/1320.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-9.0, -3.5, &r), 0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_poch_e, (-9.0, 4.0, &r), 3024.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-9.0, 3.0, &r), -504.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-9.0, 3.5, &r), 0.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_poch_e, (-9.0, 0.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_poch_e, (-8.0, -4.0, &r), 1.0/11880.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-8.0, -3.0, &r), -1.0/990.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-8.0, +4.0, &r), 1680.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-8.0, +3.0, &r), -336.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-3.0, +4.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);

  /* FIXME: we should be able to get an exact answer for poch(-a,a) if
     gsl_sf_lngamma functions were fixed to handle integer arguments
     exactly as a special case */
  TEST_SF(s,  gsl_sf_poch_e, (-3.0, +3.0, &r), -6.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_poch_e, (-4.0, +4.0, &r), 24.0, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_poch_e, (-3.0, +100.0, &r), 0.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1e-100, 0.001, &r), 1.0, TEST_TOL0, GSL_SUCCESS) ;
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (0.001, 0.001, &r), 0.9936876467088602902, TEST_TOL0, GSL_SUCCESS) ;
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (0.001, 1.0, &r), 0.9997803916424144436, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (0.001, 10.0, &r), 0.9999999958306921828, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1.0, 0.001, &r), 0.0009995001666250083319, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1.0, 1.01, &r), 0.6357810204284766802, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1.0, 10.0, &r), 0.9999546000702375151, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (10.0, 10.01, &r), 0.5433207586693410570, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (10.0, 20.0, &r), 0.9950045876916924128, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1000.0, 1000.1, &r), 0.5054666401440661753, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1000.0, 2000.0, &r), 1.0, TEST_TOL0, GSL_SUCCESS);
  /* Test for failure of the Gautschi recurrence (now fixed) for x = a - 2 */
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (34.0, 32.0, &r), 0.3849626436463866776322932129, TEST_TOL2, GSL_SUCCESS);
  /* and the next test is gamma_inc_P(37,35-20*eps) */
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (37.0, 3.499999999999999289e+01, &r), 0.3898035054195570860969333039, TEST_TOL2, GSL_SUCCESS);

  /* Regression test Martin Jansche <jansche@ling.ohio-state.edu> BUG#12 */
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (10, 1e-16, &r), 2.755731922398588814734648067e-167, TEST_TOL2, GSL_SUCCESS);

  /* Regression test for gsl_cdf_chisq_Pinv, (0.05, 1263131.0) */
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1263131.0, 1261282.3637, &r), 0.04994777516935182963821362168, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (1263131.0, 1263131.0, &r), 0.500118321758657770672882362502514254, TEST_TOL4, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (0.0, 0.001, &r), 0.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (0.001, 0.001, &r), 0.006312353291139709793, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (0.001, 1.0, &r), 0.00021960835758555639171, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (0.001, 2.0, &r), 0.00004897691783098147880, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (0.001, 5.0, &r), 1.1509813397308608541e-06, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0, 0.001, &r), 0.9990004998333749917, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0, 1.01, &r), 0.3642189795715233198, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0, 10.0, &r), 0.00004539992976248485154, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (10.0, 10.01, &r), 0.4566792413306589430, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (10.0, 100.0, &r), 1.1253473960842733885e-31, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1000.0, 1000.1, &r), 0.4945333598559338247, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1000.0, 2000.0, &r), 6.847349459614753180e-136, TEST_TOL2, GSL_SUCCESS);

  /* designed to trap the a-x=1 problem */
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (100,  99.0, &r), 0.5266956696005394, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (200, 199.0, &r), 0.5188414119121281, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (100,  99.0, &r), 0.4733043303994607, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (200, 199.0, &r), 0.4811585880878718, TEST_TOL2, GSL_SUCCESS);

  /* Test for x86 cancellation problems */
  TEST_SF(s, gsl_sf_gamma_inc_P_e, (5670, 4574, &r),  3.063972328743934e-55, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (5670, 4574, &r), 1.0000000000000000, TEST_TOL2, GSL_SUCCESS);

  /* test suggested by Michel Lespinasse [gsl-discuss Sat, 13 Nov 2004] */
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0e+06-1.0, 1.0e+06-2.0, &r), 0.50026596175224547004, TEST_TOL3, GSL_SUCCESS);

  /* tests in asymptotic regime related to Lespinasse test */
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0e+06+2.0, 1.0e+06+1.0, &r), 0.50026596135330304336, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0e+06, 1.0e+06-2.0, &r), 0.50066490399940144811, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_Q_e, (1.0e+07, 1.0e+07-2.0, &r), 0.50021026104978614908, TEST_TOL2, GSL_SUCCESS);

  /* non-normalized "Q" function */
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0/1048576.0, 1.0/1048576.0, &r), 13.285819596290624271, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.001, 1.0/1048576.0, &r), 13.381275128625328858, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0,   1.0/1048576.0, &r), 1.0485617142715768655e+06, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.00001,0.001, &r), 6.3317681434563592142, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.0001,0.001, &r), 6.3338276439767189385, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.001, 0.001, &r), 6.3544709102510843793, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.5,   0.001, &r), 59.763880515942196981, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0,   0.001, &r), 992.66896046923884234, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-3.5,   0.001, &r), 9.0224404490639003706e+09, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-10.5,  0.001, &r), 3.0083661558184815656e+30, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.001, 0.1,   &r), 1.8249109609418620068, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.5,   0.1,   &r), 3.4017693366916154163, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-10.0,  0.1,   &r), 8.9490757483586989181e+08, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-10.5,  0.1,   &r), 2.6967403834226421766e+09, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.001, 1.0,   &r), 0.21928612679072766340, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.5,   1.0,   &r), 0.17814771178156069019, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0,   1.0,   &r), 0.14849550677592204792, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-2.5,   1.0,   &r), 0.096556648631275160264, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0,   10.0,  &r), 3.8302404656316087616e-07, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.001, 10.0,  &r), 4.1470562324807320961e-06, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-0.5,   10.0,  &r), 1.2609042613241570681e-06, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-1.0,   10.0,  &r), 3.8302404656316087616e-07, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-10.5,  10.0,  &r), 6.8404927328441566785e-17, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-100.0, 10.0,  &r), 4.1238327669858313997e-107, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (-200.0, 10.0,  &r), 2.1614091830529343423e-207, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.0,     0.001, &r), 6.3315393641361493320, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.001,   0.001, &r), 6.3087159394864007261, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  1.0,     0.001, &r), 0.99900049983337499167, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, ( 10.0,     0.001, &r), 362880.0, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.0,     1.0,   &r), 0.21938393439552027368, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.001,   1.0,   &r), 0.21948181320730279613, TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  1.0,     1.0,   &r), 0.36787944117144232160, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, ( 10.0,     1.0,   &r), 362879.95956592242045, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (100.0,     1.0,   &r), 9.3326215443944152682e+155, TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.0,   100.0, &r), 3.6835977616820321802e-46, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  0.001, 100.0, &r), 3.7006367674063550631e-46, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (  1.0,   100.0, &r), 3.7200759760208359630e-44, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, ( 10.0,   100.0, &r), 4.0836606309106112723e-26, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_gamma_inc_e, (100.0,   100.0, &r), 4.5421981208626694294e+155, TEST_TOL1, GSL_SUCCESS);

  TEST_SF(s, gsl_sf_lnbeta_e, (1.0e-8, 1.0e-8, &r),  19.113827924512310617 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0e-8, 0.01, &r),  18.420681743788563403 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0e-8, 1.0, &r),  18.420680743952365472 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0e-8, 10.0, &r),  18.420680715662683009 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0e-8, 1000.0, &r),  18.420680669107656949 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (0.1, 0.1, &r), 2.9813614810376273949 , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (0.1, 1.0, &r),  2.3025850929940456840 , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (0.1, 100.0, &r),  1.7926462324527931217 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (0.1, 1000, &r),  1.5619821298353164928 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0, 1.00025, &r),  -0.0002499687552073570, TEST_TOL4, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0, 1.01, &r),  -0.009950330853168082848 , TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (1.0, 1000.0, &r),  -6.907755278982137052 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (100.0, 100.0, &r),  -139.66525908670663927 , TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (100.0, 1000.0, &r),  -336.4348576477366051 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s, gsl_sf_lnbeta_e, (100.0, 1.0e+8, &r),  -1482.9339185256447309 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (1.0,   1.0, &r), 1.0                   , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (1.0, 1.001, &r), 0.9990009990009990010 , TEST_TOL0, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (1.0,   5.0, &r), 0.2                   , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (1.0,  100.0, &r), 0.01                  , TEST_TOL1, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (10.0, 100.0, &r), 2.3455339739604649879e-15 , TEST_TOL2, GSL_SUCCESS);

  /* Test negative arguments */
  TEST_SF(s,  gsl_sf_beta_e, (2.5, -0.1, &r), -11.43621278354402041480, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (2.5, -1.1, &r), 14.555179906328753255202, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-0.25, -0.1, &r), -13.238937960945229110, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-1.25, -0.1, &r), -14.298052997820847439, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-100.1, -99.1, &r), -1.005181917797644630375787297e60, TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-100.1, 99.3, &r), 0.0004474258199579694011200969001, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (100.1, -99.3, &r), 1.328660939628876472028853747, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-100.1, 1.2, &r), 0.00365530364287960795444856281, TEST_TOL3, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (100.1, -1.2, &r), 1203.895236907821059270698160, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-100.1, -1.2, &r), -3236.073671884748847700283841, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (-100.001, 0.0099, &r), -853.946649365611147996495177, TEST_TOL4, GSL_SUCCESS);

  /* Other test cases */
  TEST_SF(s,  gsl_sf_beta_e, (1e-32, 1.5, &r), 1e32, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_e, (1e-6, 0.5, &r), 1000001.386293677092419390336, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_e, (-1.5, 0.5, &r), 0.0, TEST_TOL0, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_inc_e, (1.0, 1.0, 0.0, &r), 0.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (1.0, 1.0, 1.0, &r), 1.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (0.1, 0.1, 1.0, &r), 1.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0,  1.0, 0.5, &r), 0.5, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 0.1,  1.0, 0.5, &r), 0.9330329915368074160, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (10.0,  1.0, 0.5, &r), 0.0009765625000000000000, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (50.0,  1.0, 0.5, &r), 8.881784197001252323e-16, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0,  0.1, 0.5, &r), 0.06696700846319258402, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0, 10.0, 0.5, &r), 0.99902343750000000000, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0, 50.0, 0.5, &r), 0.99999999999999911180, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0,  1.0, 0.1, &r), 0.10, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0,  2.0, 0.1, &r), 0.19, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 1.0,  2.0, 0.9, &r), 0.99, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (50.0, 60.0, 0.5, &r), 0.8309072939016694143, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (90.0, 90.0, 0.5, &r), 0.5, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, ( 500.0,  500.0, 0.6, &r), 0.9999999999157549630, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (5000.0, 5000.0, 0.4, &r), 4.518543727260666383e-91, TEST_TOL5, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (5000.0, 5000.0, 0.6, &r), 1.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (5000.0, 2000.0, 0.6, &r), 8.445388773903332659e-89, TEST_TOL5, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.1, 1.0, &r), 1.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.2, 1.0, &r), 1.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.2, -0.1, 1.0, &r), 1.0, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.2, 0.5, &r), 0.675252001958389971991335, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.2, -0.1, 0.5, &r), 0.324747998041610028008665, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.1, 0.0, &r), 0.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.2, 0.0, &r), 0.0, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.2, -0.1, 0.0, &r), 0.0, TEST_TOL2, GSL_SUCCESS);

  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.1, -0.2, 0.3, &r), 0.7469186777964287252, TEST_TOL2, GSL_SUCCESS);
  TEST_SF(s,  gsl_sf_beta_inc_e, (-0.2, -0.1, 0.3, &r), 0.3995299653262016818, TEST_TOL2, GSL_SUCCESS);

  /* Bug report from Thomas Tanner <tanner@gmx.de> */

  TEST_SF(s,  gsl_sf_beta_inc_e, (0.5, 101.5, 0.999457, &r), 1.0, TEST_TOL2, GSL_SUCCESS);

  return s;
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include <pthread.h>

#include <gsl/gsl_sf.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_statistics.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_roots.h>

#include "LNAbundance.h"

static int  verbose  = FALSE;

static int  nLines   = 9;

static char *usage[] = {"LNAbundance - \n",
                        "Required parameters:\n",
			"   -a    abundance data\n",
			"   -in   filename      parameter file  \n",
                        "Optional:\n",
			"   -b    integer       length of sample file to ignore\n",
			"   -s    integer       sampling frequency\n",
			"   -seed long          seed random number generator\n",
			"   -v                  verbose\n"};

void updateExpectations(double* adExpect, int nMax, double dMDash, double dV, int nS, t_Data *ptData)
{
  int i = 0;

  for(i = 1; i <= nMax; i++){
    int nA = i;
    double dLog = 0.0, dP = 0.0;

    if(nA < MAX_QUAD){
      dLog = logLikelihoodQuad(nA, dMDash, dV);
    }
    else{
      dLog = logLikelihoodRampal(nA, dMDash, dV);
    }

    dP = exp(dLog);

    adExpect[i - 1]+= dP*nS;
  }
}

int main(int argc, char* argv[]){
  t_Params    tParams;
  t_LNParams* atLNParams;
  int         i = 0, nSamples = 0, nMax = 0;
  t_Data      tData;
  double*     adExpect = NULL;

  gsl_set_error_handler_off();

  getCommandLineParams(&tParams, argc, argv);

  /*allocate memory for samples*/
  atLNParams = (t_LNParams *) malloc(MAX_SAMPLES*sizeof(t_LNParams));
  if(!atLNParams)
    goto memoryError;

  /*read in Monte-Carlo samples*/
  readSamples(&tParams, atLNParams, &nSamples);

  readAbundanceData(tParams.szAbundFile, &tData);

  nMax = tData.aanAbund[tData.nNA - 1][0];
  nMax = floor(pow(2.0,ceil(log((double) nMax)/log(2.0)) + 2.0) + 1.0e-7);

  adExpect = (double *) malloc(sizeof(double)*nMax);

  for(i = 0; i < nMax; i++){
    adExpect[i] = 0.0;
  }

  for(i = 0; i < nSamples; i++){
    updateExpectations(adExpect, nMax,
		       atLNParams[i].dMDash,
		       atLNParams[i].dV,
		       atLNParams[i].nS,
		       &tData);
  }

  for(i = 1; i <= nMax; i++){
    printf("%d %f\n",i,adExpect[i - 1]/((double) nSamples));
  }

  free(adExpect);
  exit(EXIT_SUCCESS);

 memoryError:
  fprintf(stderr, "Failed to allocate memory in main aborting ...\n");
  fflush(stderr);
  exit(EXIT_FAILURE);
}

int intCompare(const void *pvA, const void *pvB)
{
  int* pnA = (int *) pvA, *pnB = (int *) pvB;

  if(*pnA < *pnB)
    return +1;
  else if(*pnA == *pnB){
    return 0;
  }
  else{
    return -1;
  }
}

int doubleCompare(const void *pvA, const void *pvB)
{
  double* pnA = (double *) pvA, *pnB = (double *) pvB;

  if(*pnA < *pnB)
    return +1;
  else if(*pnA == *pnB){
    return 0;
  }
  else{
    return -1;
  }
}

void writeUsage(FILE* ofp)
{
  int i = 0;
  char *line;

  for(i = 0; i < nLines; i++){
    line = usage[i];
    fputs(line,ofp);
  }
}

char *extractParameter(int argc, char **argv, char *param,int when)
{
  int i = 0;

  while((i < argc) && (strcmp(param,argv[i]))){
    i++;
  }

  if(i < argc - 1){
    return(argv[i + 1]);
  }

  if((i == argc - 1) && (when == OPTION)){
    return "";
  }

  if(when == ALWAYS){
    fprintf(stdout,"Can't find asked option %s\n",param);
  }

  return (char *) NULL;
}

void getCommandLineParams(t_Params *ptParams,int argc,char *argv[])
{
  char *szTemp = NULL;
  char *cError = NULL;

  /*get parameter file name*/
  ptParams->szInputFile  = extractParameter(argc,argv, INPUT_FILE,ALWAYS);
  if(ptParams->szInputFile == NULL)
    goto error;

 /*get abundance file name*/
  ptParams->szAbundFile  = extractParameter(argc,argv, ABUND_FILE,ALWAYS);
  if(ptParams->szAbundFile == NULL)
    goto error;

  /*get long seed*/
  szTemp  = extractParameter(argc,argv,SEED,OPTION);
  if(szTemp != NULL){
    ptParams->lSeed = strtol(szTemp,&cError,10);
    if(*cError != '\0'){
      goto error;
    }
  }
  else{
    ptParams->lSeed = 0;
  }

  /*get burn*/
  szTemp  = extractParameter(argc, argv, BURN, OPTION);
  if(szTemp != NULL){
    ptParams->nBurn = strtol(szTemp,&cError,10);
    if(*cError != '\0'){
      goto error;
    }
  }
  else{
    ptParams->nBurn = DEF_BURN;
  }

 /*get long seed*/
  szTemp  = extractParameter(argc, argv, SAMPLE, OPTION);
  if(szTemp != NULL){
    ptParams->nSample = strtol(szTemp,&cError,10);
    if(*cError != '\0'){
      goto error;
    }
  }
  else{
    ptParams->nSample = DEF_SAMPLE;
  }

  /*verbosity*/
  szTemp = extractParameter(argc, argv, VERBOSE, OPTION);
  if(szTemp != NULL){
    verbose = TRUE;
  }

  return;

 error:
  writeUsage(stdout);
  exit(EXIT_FAILURE);
}

void readSamples(t_Params *ptParams, t_LNParams *atLNParams, int *pnSamples)
{
  int  nSamples = 0;
  char *szInputFile = ptParams->szInputFile;
  char szLine[MAX_LINE_LENGTH];
  FILE *ifp = NULL;

  ifp = fopen(szInputFile, "r");

  if(ifp){
    while(fgets(szLine, MAX_LINE_LENGTH, ifp)){
      char *szTok = NULL, *szBrk = NULL, *pcError = NULL;
      int  nTime  = 0;

      /*remove trailing new line*/
      szBrk = strpbrk(szLine, "\n"); (*szBrk) = '\0';

      szTok = strtok(szLine, DELIM);

      nTime = strtol(szTok, &pcError, 10);
      if(*pcError != '\0') goto fileFormatError;

      if(nTime > ptParams->nBurn && nTime % ptParams->nSample == 0){

	szTok = strtok(NULL,DELIM);
	atLNParams[nSamples].dMDash = strtod(szTok, &pcError);
	if(*pcError != '\0') goto fileFormatError;

	szTok = strtok(NULL,DELIM);
	atLNParams[nSamples].dV = strtod(szTok, &pcError);
	if(*pcError != '\0') goto fileFormatError;

	szTok = strtok(NULL,DELIM);
	atLNParams[nSamples].nS = strtol(szTok, &pcError, 10);
	if(*pcError != '\0') goto fileFormatError;

	nSamples++;
      }
    }

    fclose(ifp);
  }
  else{
    fprintf(stderr, "Failed to open file %s aborting\n", szInputFile);
    fflush(stderr);
    exit(EXIT_FAILURE);
  }

  (*pnSamples) = nSamples;
  return;

 fileFormatError:
  fprintf(stderr, "Incorrectly formatted input file aborting\n");
  fflush(stderr);
  exit(EXIT_FAILURE);
}

double f1(double x, void *pvParams)
{
  t_LNParams *ptLNParams = (t_LNParams *) pvParams;
  double dMDash = ptLNParams->dMDash, dV = ptLNParams->dV, n = ptLNParams->n;
  double dTemp = (x - dMDash);
  double dExp  = x*((double) n) - exp(x) - 0.5*((dTemp*dTemp)/dV);
  double dRet  = exp(dExp);

  return dRet;
}

double logLikelihoodRampal(int n, double dMDash, double dV)
{
  double dN = (double) n;
  double dLogLik = 0.0, dTemp = gsl_pow_int(log(dN) - dMDash,2), dTemp3 = gsl_pow_int(log(dN) - dMDash,3);

  dLogLik = -0.5*log(2.0*M_PI*dV) - log(dN) - (dTemp/(2.0*dV));

  dLogLik += log(1.0 + 1.0/(2.0*dN*dV)*(dTemp/dV + log(dN) - dMDash - 1.0)
		 + 1.0/(6.0*dN*dN*dV*dV*dV)*(3.0*dV*dV - (3.0*dV - 2.0*dV*dV)*(dMDash - log(dN))
		 - 3.0*dV*dTemp + dTemp3));

  return dLogLik;
}

double logLikelihoodQuad(int n, double dMDash, double dV)
{
  gsl_integration_workspace *ptGSLWS =
    gsl_integration_workspace_alloc(1000);
  double dLogFac1   = 0.0, dLogFacN  = 0.0;
  double dResult = 0.0, dError = 0.0, dPrecision = 0.0;
  gsl_function tGSLF;
  t_LNParams tLNParams;
  double dEst = dMDash + ((double)n)*dV, dA = 0.0, dB = 0.0;

  tLNParams.n = n; tLNParams.dMDash = dMDash; tLNParams.dV = dV;

  tGSLF.function = &f1;
  tGSLF.params   = (void *) &tLNParams;

  dLogFac1 = log(2.0*M_PI*dV);

  if(n < 50){
    dLogFacN = gsl_sf_fact(n);
    dLogFacN = log(dLogFacN);
  }
  else{
    dLogFacN = gsl_sf_lngamma(((double) n) + 1.0);
  }

  if(dEst > dV){
    double dMax = 0.0;
    double dUpper = (((double) n) + (dMDash/dV) - 1.0)/(1.0 + 1.0/dV);
    double dVar   = 0.0;

    solveF(0.0, dUpper, derivExponent, (void *) &tLNParams, 1.0e-5, &dMax);

    dVar = sqrt(1.0/((1.0/dV) + exp(dMax)));

    dA = dMax - V_MULT*dVar; dB = dMax + V_MULT*dVar;
  }
  else{
    double dMax = 0.0;
    double dLower = dEst - dV;
    double dUpper = (((double) n) + (dMDash/dV) - 1.0)/(1.0 + 1.0/dV);
    double dVar   = 0.0;

    solveF(dLower, dUpper, derivExponent, (void *) &tLNParams, 1.0e-5, &dMax);

    dVar = sqrt(1.0/((1.0/dV) + exp(dMax)));

    dA = dMax - V_MULT*dVar; dB = dMax + V_MULT*dVar;
  }

  if(n < 10){
    dPrecision = HI_PRECISION;
  }
  else{
    dPrecision = LO_PRECISION;
  }

  gsl_integration_qag(&tGSLF, dA, dB, dPrecision, 0.0, 1000, GSL_INTEG_GAUSS61, ptGSLWS, &dResult, &dError);

  gsl_integration_workspace_free(ptGSLWS);

  return log(dResult) - dLogFacN -0.5*dLogFac1;
}

double derivExponent(double x, void *pvParams)
{
  t_LNParams *ptLNParams = (t_LNParams *) pvParams;
  double dMDash = ptLNParams->dMDash, dV = ptLNParams->dV, n = ptLNParams->n;
  double dTemp = (x - dMDash)/dV, dRet = 0.0;

  dRet = ((double) n) - exp(x) - dTemp;

  return dRet;
}

int solveF(double x_lo, double x_hi, double (*f)(double, void*),
	   void* params, double tol, double *xsolve)
{
  int status, iter = 0, max_iter = 100;
  const gsl_root_fsolver_type *T;
  gsl_root_fsolver *s;
  double r = 0;
  gsl_function F;

  F.function = f;
  F.params = params;

  T = gsl_root_fsolver_brent;
  s = gsl_root_fsolver_alloc (T);
  gsl_root_fsolver_set (s, &F, x_lo, x_hi);

  do{
    iter++;
    status = gsl_root_fsolver_iterate (s);
    r = gsl_root_fsolver_root (s);
    x_lo = gsl_root_fsolver_x_lower (s);
    x_hi = gsl_root_fsolver_x_upper (s);

    status = gsl_root_test_interval (x_lo, x_hi, 0, tol);
  }
  while (status == GSL_CONTINUE && iter < max_iter);

  (*xsolve) = gsl_root_fsolver_root (s);
  gsl_root_fsolver_free (s);

  return status;
}

void readAbundanceData(const char *szFile, t_Data *ptData)
{
  int **aanAbund = NULL;
  int  i = 0, nNA = 0, nA = 0, nC = 0;
  int  nL = 0, nJ = 0;
  char szLine[MAX_LINE_LENGTH];
  FILE* ifp = NULL;

  ifp = fopen(szFile, "r");

  if(ifp){
    char* szTok   = NULL;
    char* pcError = NULL;

    fgets(szLine, MAX_LINE_LENGTH, ifp);

    szTok = strtok(szLine, DELIM2);

    nNA = strtol(szTok,&pcError,10);
    if(*pcError != '\0'){
      goto formatError;
    }

    aanAbund = (int **) malloc(nNA*sizeof(int*));

    for(i = 0; i < nNA; i++){
      aanAbund[i] = (int *) malloc(sizeof(int)*2);

      fgets(szLine, MAX_LINE_LENGTH, ifp);

      szTok = strtok(szLine, DELIM2);

      nA = strtol(szTok,&pcError,10);
      if(*pcError != '\0'){
	goto formatError;
      }

      szTok = strtok(NULL, DELIM2);

      nC = strtol(szTok,&pcError,10);
      if(*pcError != '\0'){
	goto formatError;
      }

      nL += nC;
      nJ += nC*nA;

      aanAbund[i][0]  = nA;
      aanAbund[i][1]  = nC;
    }
  }
  else{
    fprintf(stderr, "Failed to open abundance data file %s aborting\n", szFile);
    fflush(stderr);
    exit(EXIT_FAILURE);
  }

  ptData->nJ          = nJ;
  ptData->nL          = nL;
  ptData->aanAbund    = aanAbund;
  ptData->nNA         = nNA;
  return;

 formatError:
  fprintf(stderr, "Incorrectly formatted abundance data file\n");
  fflush(stderr);
  exit(EXIT_FAILURE);
}


#include "ccv.h"
#ifdef HAVE_CBLAS
#include <cblas.h>
#endif

double ccv_trace(ccv_matrix_t* mat)
{
	return 0;
}

double ccv_norm(ccv_matrix_t* mat, int type)
{
	return 0;
}

double ccv_normalize(ccv_matrix_t* a, ccv_matrix_t** b, int btype, int l_type)
{
	ccv_dense_matrix_t* da = ccv_get_dense_matrix(a);
	assert(CCV_GET_CHANNEL(da->type) == CCV_C1);
	char identifier[20];
	memset(identifier, 0, 20);
	snprintf(identifier, 20, "ccv_normalize(%d)", l_type);
	uint64_t sig = (da->sig == 0) ? 0 : ccv_matrix_generate_signature(identifier, 20, da->sig, 0);
	btype = (btype == 0) ? CCV_GET_DATA_TYPE(da->type) | CCV_C1 : CCV_GET_DATA_TYPE(btype) | CCV_C1;
	ccv_dense_matrix_t* db = *b = ccv_dense_matrix_renew(*b, da->rows, da->cols, CCV_ALL_DATA_TYPE | CCV_C1, btype, sig);
	ccv_cache_return(db, 0);
	double sum = 0;
	int i, j;
	unsigned char* a_ptr = da->data.ptr;
	unsigned char* b_ptr = db->data.ptr;
	switch (l_type)
	{
		case CCV_L2_NORM:
#define for_block(__for_set, __for_get) \
			for (i = 0; i < da->rows; i++) \
			{ \
				for (j = 0; j < da->cols; j++) \
					sum += __for_get(a_ptr, j, 0) * __for_get(a_ptr, j, 0); \
				a_ptr += da->step; \
			} \
			sum = sqrt(sum); \
			double inv = 1.0 / sqrt(sum); \
			a_ptr = da->data.ptr; \
			for (i = 0; i < da->rows; i++) \
			{ \
				for (j = 0; j < da->cols; j++) \
					__for_set(b_ptr, j, __for_get(a_ptr, j, 0) * inv, 0); \
				a_ptr += da->step; \
				b_ptr += db->step; \
			}
			ccv_matrix_setter(db->type, ccv_matrix_getter, da->type, for_block);
#undef for_block
			break;
	}
	return sum;
}

double ccv_sum(ccv_matrix_t* mat)
{
	ccv_dense_matrix_t* dmt = ccv_get_dense_matrix(mat);
	double sum = 0;
	unsigned char* m_ptr = dmt->data.ptr;
	int i, j;
#define for_block(dummy, __for_get) \
	for (i = 0; i < dmt->rows; i++) \
	{ \
		for (j = 0; j < dmt->cols; j++) \
			sum += __for_get(m_ptr, j, 0); \
		m_ptr += dmt->step; \
	}
	ccv_matrix_getter(dmt->type, for_block);
#undef for_block
	return sum;
}

void ccv_zero(ccv_matrix_t* mat)
{
	ccv_dense_matrix_t* dmt = ccv_get_dense_matrix(mat);
	memset(dmt->data.ptr, 0, dmt->step * dmt->rows);
}

void ccv_substract(ccv_matrix_t* a, ccv_matrix_t* b, ccv_matrix_t** c, int type)
{
	ccv_dense_matrix_t* da = ccv_get_dense_matrix(a);
	ccv_dense_matrix_t* db = ccv_get_dense_matrix(b);
	assert(da->rows == db->rows && da->cols == db->cols && CCV_GET_DATA_TYPE(da->type) == CCV_GET_DATA_TYPE(db->type) && CCV_GET_CHANNEL(da->type) == CCV_GET_CHANNEL(db->type));
	uint64_t sig = ccv_matrix_generate_signature("ccv_substract", 13, da->sig, db->sig, 0);
	int no_8u_type = (da->type & CCV_8U) ? CCV_32S : da->type;
	type = (type == 0) ? CCV_GET_DATA_TYPE(no_8u_type) | CCV_GET_CHANNEL(da->type) : CCV_GET_DATA_TYPE(type) | CCV_GET_CHANNEL(da->type);
	ccv_dense_matrix_t* dc = *c = ccv_dense_matrix_renew(*c, da->rows, da->cols, CCV_ALL_DATA_TYPE | CCV_GET_CHANNEL(da->type), type, sig);
	ccv_cache_return(dc, );
	int i, j;
	unsigned char* aptr = da->data.ptr;
	unsigned char* bptr = db->data.ptr;
	unsigned char* cptr = dc->data.ptr;
#define for_block(__for_get, __for_set) \
	for (i = 0; i < da->rows; i++) \
	{ \
		for (j = 0; j < da->cols; j++) \
		{ \
			__for_set(cptr, j, __for_get(aptr, j, 0) - __for_get(bptr, j, 0), 0); \
		} \
		aptr += da->step; \
		bptr += db->step; \
		cptr += dc->step; \
	}
	ccv_matrix_getter(da->type, ccv_matrix_setter, dc->type, for_block);
#undef for_block
}

void ccv_gemm(ccv_matrix_t* a, ccv_matrix_t* b, double alpha, ccv_matrix_t* c, double beta, int transpose, ccv_matrix_t** d, int type)
{
	ccv_dense_matrix_t* da = ccv_get_dense_matrix(a);
	ccv_dense_matrix_t* db = ccv_get_dense_matrix(b);
	ccv_dense_matrix_t* dc = (c == 0) ? 0 : ccv_get_dense_matrix(c);

	assert(CCV_GET_DATA_TYPE(da->type) == CCV_GET_DATA_TYPE(db->type) && CCV_GET_CHANNEL_NUM(da->type) == 1 && CCV_GET_CHANNEL_NUM(db->type) == 1 && ((transpose & CCV_A_TRANSPOSE) ? da->rows : da->cols) == ((transpose & CCV_B_TRANSPOSE) ? db->cols : db->rows));

	if (dc != 0)
		assert(CCV_GET_DATA_TYPE(dc->type) == CCV_GET_DATA_TYPE(da->type) && CCV_GET_CHANNEL_NUM(dc->type) == 1 && ((transpose & CCV_A_TRANSPOSE) ? da->cols : da->rows) == dc->rows && ((transpose & CCV_B_TRANSPOSE) ? db->rows : db->cols) == dc->cols);

	char identifier[20];
	memset(identifier, 0, 20);
	snprintf(identifier, 20, "ccv_gemm(%d)", transpose);
	uint64_t sig = (dc == 0) ? ((da->sig == 0 || db->sig == 0) ? 0 : ccv_matrix_generate_signature(identifier, 20, da->sig, db->sig, 0)) : ((da->sig == 0 || db->sig == 0 || dc->sig == 0) ? 0 : ccv_matrix_generate_signature(identifier, 20, da->sig, db->sig, dc->sig, 0));
	type = CCV_GET_DATA_TYPE(da->type) | CCV_GET_CHANNEL(da->type);
	ccv_dense_matrix_t* dd = *d = ccv_dense_matrix_renew(*d, (transpose & CCV_A_TRANSPOSE) ? da->cols : da->rows, (transpose & CCV_B_TRANSPOSE) ? db->rows : db->cols, type, type, sig);
	ccv_cache_return(dd, );

	if (dd != dc && dc != 0)
		memcpy(dd->data.ptr, dc->data.ptr, dc->step * dc->rows);

#ifdef HAVE_CBLAS
	switch (CCV_GET_DATA_TYPE(dd->type))
	{
		case CCV_32F:
			cblas_sgemm(CblasRowMajor, (transpose & CCV_A_TRANSPOSE) ? CblasTrans : CblasNoTrans, (transpose & CCV_B_TRANSPOSE) ? CblasTrans : CblasNoTrans, dd->rows, dd->cols, da->cols, alpha, da->data.fl, da->cols, db->data.fl, db->cols, beta, dd->data.fl, dd->cols);
			break;
		case CCV_64F:
			cblas_dgemm(CblasRowMajor, (transpose & CCV_A_TRANSPOSE) ? CblasTrans : CblasNoTrans, (transpose & CCV_B_TRANSPOSE) ? CblasTrans : CblasNoTrans, dd->rows, dd->cols, (transpose & CCV_A_TRANSPOSE) ? da->rows : da->cols, alpha, da->data.db, da->cols, db->data.db, db->cols, beta, dd->data.db, dd->cols);
			break;
	}
#endif
}


/*
 * testnonsymm.c
 * Patrick Alken
 *
 * Compile: gcc -g -O2 -Wall -o testnonsymm testnonsymm.c -lm -lgsl -lcblas -latlas
 *
 * Usage: testnonsymm [options]
 *
 * -i             : incremental matrices
 * -b             : balance the matrices
 * -z             : compute Schur vectors and test them
 * -n size        : size of matrices
 * -l lower-bound : lower bound for matrix elements
 * -u upper-bound : upper bound for matrix elements
 * -c num         : number of matrices to solve
 */

#include <stdio.h>
#include <stdlib.h>
#include <unistd.h>
#include <string.h>
#include <errno.h>
#include <math.h>
#include <getopt.h>
#include <sys/times.h>

#include <gsl/gsl_eigen.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_test.h>

typedef struct
{
  gsl_eigen_nonsymm_workspace *nonsymm_p;
  gsl_eigen_nonsymmv_workspace *nonsymmv_p;
  gsl_matrix *A;
  gsl_matrix *Av;
  gsl_vector_complex *eval;
  gsl_vector_complex *evalv;
  gsl_matrix_complex *evec;

  int compute_z;
  gsl_matrix *Z;
  gsl_matrix *Zv;

  size_t n_evals;
} nonsymm_workspace;

nonsymm_workspace *nonsymm_alloc(size_t n, int compute_z, int do_balance);
void nonsymm_free(nonsymm_workspace *w);
int nonsymm_proc(nonsymm_workspace *w);

/*
 * Global variables
 */
unsigned long count = 0;

/*
 * Prototypes
 */

void make_random_matrix(gsl_matrix *m, gsl_rng *r, int lower,
                        int upper);
void make_start_matrix(gsl_matrix *m, int lower);
int inc_matrix (gsl_matrix *m, int lower, int upper);
void output_matrix(gsl_matrix *m);
void print_octave(gsl_matrix *m, const char *str);
void print_matrix(gsl_matrix *m, const char *str);
void print_hess(gsl_matrix *H, const char *str);
void print_vector(gsl_vector_complex *eval, const char *str);
int cmp(double a, double b);
int compare(const void *a, const void *b);
void sort_complex_vector(gsl_vector_complex *v);
int test_evals(gsl_vector_complex *obs, gsl_vector_complex *expected,
               gsl_matrix *A, const char *obsname, const char *expname);
int test_Z(gsl_matrix *A, gsl_matrix *Z, gsl_matrix *T);
int test_eigenvectors(gsl_matrix *A, gsl_vector_complex *eval,
                      gsl_matrix_complex *evec);
void my_error_handler(const char *reason, const char *file, int line,
                      int err);

nonsymm_workspace *
nonsymm_alloc(size_t n, int compute_z, int do_balance)

{
  nonsymm_workspace *w;

  w = (nonsymm_workspace *) malloc(sizeof(nonsymm_workspace));

  memset(w, '\0', sizeof(nonsymm_workspace));

  w->nonsymm_p = gsl_eigen_nonsymm_alloc(n);
  w->nonsymmv_p = gsl_eigen_nonsymmv_alloc(n);

  w->A = gsl_matrix_alloc(n, n);
  w->Av = gsl_matrix_alloc(n, n);

  if (compute_z)
    {
      w->Z = gsl_matrix_alloc(n, n);
      w->Zv = gsl_matrix_alloc(n, n);
      w->compute_z = 1;
      gsl_eigen_nonsymm_params(1, do_balance, w->nonsymm_p);
    }
  else
    gsl_eigen_nonsymm_params(0, do_balance, w->nonsymm_p);

  w->eval = gsl_vector_complex_alloc(n);
  w->evalv = gsl_vector_complex_alloc(n);

  w->evec = gsl_matrix_complex_alloc(n, n);

  return (w);
} /* nonsymm_alloc() */

void
nonsymm_free(nonsymm_workspace *w)

{
  if (w->nonsymm_p)
    gsl_eigen_nonsymm_free(w->nonsymm_p);

  if (w->nonsymmv_p)
    gsl_eigen_nonsymmv_free(w->nonsymmv_p);

  if (w->A)
    gsl_matrix_free(w->A);

  if (w->Av)
    gsl_matrix_free(w->Av);

  if (w->Z)
    gsl_matrix_free(w->Z);

  if (w->Zv)
    gsl_matrix_free(w->Zv);

  if (w->eval)
    gsl_vector_complex_free(w->eval);

  if (w->evalv)
    gsl_vector_complex_free(w->evalv);

  if (w->evec)
    gsl_matrix_complex_free(w->evec);

  free(w);
} /* nonsymm_free() */

int
nonsymm_proc(nonsymm_workspace *w)

{
  int s1, s2, s;

  if (w->compute_z)
    {
      s1 = gsl_eigen_nonsymm_Z(w->A, w->eval, w->Z, w->nonsymm_p);
      s2 = gsl_eigen_nonsymmv_Z(w->Av, w->evalv, w->evec, w->Zv, w->nonsymmv_p);
    }
  else
    {
      s1 = gsl_eigen_nonsymm(w->A, w->eval, w->nonsymm_p);
      s2 = gsl_eigen_nonsymmv(w->Av, w->evalv, w->evec, w->nonsymmv_p);
    }

  w->n_evals = w->nonsymm_p->n_evals;

  s = 0;
  if (s1)
    s = s1;
  else if (s2)
    s = s2;

  return s;
} /* nonsymm_proc() */

/**********************************************
 * General routines
 **********************************************/

void
make_random_matrix(gsl_matrix *m, gsl_rng *r, int lower, int upper)

{
  size_t i, j;
  size_t N = m->size1;

  for (i = 0; i < N; ++i)
  {
    for (j = 0; j < N; ++j)
    {
      gsl_matrix_set(m,
                     i,
                     j,
                     gsl_rng_uniform(r) * (upper - lower) + lower);
    }
  }
} /* make_random_matrix() */

void
make_start_matrix(gsl_matrix *m, int lower)

{
  size_t i, j;
  size_t N = m->size1;

  for (i = 0; i < N; ++i)
    for (j = 0; j < N; ++j)
      gsl_matrix_set(m, i, j, (double)lower);
} /* make_start_matrix() */

int
inc_matrix (gsl_matrix *m, int lower, int upper)
{
  size_t i = 0;
  size_t N = m->size1 * m->size2;
  int carry = 1;

  for (i = 0; carry > 0 && i < N; i++)
    {
      double v = m->data[i] + carry;
      carry = (v > upper) ? 1 : 0;
      m->data[i] = (v > upper) ? lower : v;
    }

  return carry;
} /* inc_matrix() */

void
output_matrix(gsl_matrix *m)
{
  size_t i, j;
  size_t N = m->size1;
  size_t M = m->size2;

  for (i = 0; i < N; ++i)
  {
    for (j = 0; j < M; ++j)
      {
        /*printf("%10.9f%s",*/
        printf("%10.18e%s",
               gsl_matrix_get(m, i, j),
               (j < M - 1) ? "," : ";\n");
      }
  }
}

void
print_octave(gsl_matrix *m, const char *str)
{
  FILE *fp;
  size_t i, j;
  const size_t N = m->size1;
  const size_t M = m->size2;

  fp = fopen(str, "w");

  if (!fp)
    return;

  fprintf(fp, "# Created by Octave 2.1.73, Tue Aug 01 15:00:27 2006 MDT <blah@blah>\n");
  fprintf(fp, "# name: %s\n", str);
  fprintf(fp, "# type: matrix\n");
  fprintf(fp, "# rows: %u\n", N);
  fprintf(fp, "# columns: %u\n", N);

  for (i = 0; i < N; ++i)
    {
      for (j = 0; j < M; ++j)
        {
          fprintf(fp,
                  "%10.9f%s",
                  gsl_matrix_get(m, i, j),
                  (j < M - 1) ? " " : "\n");
        }
    }

  fclose(fp);
}

void
print_matrix(gsl_matrix *m, const char *str)

{
  size_t i, j;
  size_t N = m->size1;
  size_t M = m->size2;
  gsl_matrix_view v;
  size_t rows, cols;
  size_t r, c;
  char buf[100];

  /*print_octave(m, str);
  return;*/

  /*rows = GSL_MIN(15, N);*/
  rows = N;
  cols = GSL_MIN(15, N);
  /*cols = N;*/

  for (i = 0; i < N; i += rows)
  {
    for (j = 0; j < M; j += cols)
    {
      r = GSL_MIN(rows, N - i);
      c = GSL_MIN(cols, N - j);

      v = gsl_matrix_submatrix(m,
                               i,
                               j,
                               r,
                               c);

      sprintf(buf, "%s(%u:%u,%u:%u)",
              str,
              i + 1,
              i + r,
              j + 1,
              j + c);

      printf("%s = [\n", buf);

      output_matrix(&v.matrix);

      printf("]\n");
    }
  }
} /* print_matrix() */

void
print_vector(gsl_vector_complex *eval, const char *str)

{
  size_t N = eval->size;
  size_t i;
  gsl_complex z;

  printf("%s = [\n", str);

  for (i = 0; i < N; ++i)
    {
      z = gsl_vector_complex_get(eval, i);
      printf("%.18e %.18e;\n", GSL_REAL(z), GSL_IMAG(z));
    }

  printf("\n]\n");
} /* print_vector() */

int
cmp(double a, double b)

{
  return ((a > b) ? 1 : ((a < b) ? -1 : 0));
} /* cmp() */

int
compare(const void *a, const void *b)

{
  const double *x = a;
  const double *y = b;
  int r1 = cmp(y[0], x[0]);
  int r2 = cmp(y[1], x[1]);

  if (fabs(x[0] - y[0]) < 1.0e-8)
    {
      /* real parts are very close to each other */
      return r2;
    }
  else
    {
      return r1 ? r1 : r2;
    }
} /* compare() */

void
sort_complex_vector(gsl_vector_complex *v)

{
  qsort(v->data, v->size, 2 * sizeof(double), &compare);
} /* sort_complex_vector() */

int
test_evals(gsl_vector_complex *obs, gsl_vector_complex *expected,
           gsl_matrix *A, const char *obsname, const char *expname)

{
  size_t N = expected->size;
  size_t i, k;
  double max, max_abserr, max_relerr;

  max = 0.0;
  max_abserr = 0.0;
  max_relerr = 0.0;
  k = 0;

  for (i = 0; i < N; ++i)
    {
      gsl_complex z = gsl_vector_complex_get(expected, i);
      max = GSL_MAX_DBL(max, gsl_complex_abs(z));
    }

  for (i = 0; i < N; ++i)
    {
      gsl_complex z_obs = gsl_vector_complex_get(obs, i);
      gsl_complex z_exp = gsl_vector_complex_get(expected, i);

      double x_obs = GSL_REAL(z_obs);
      double y_obs = GSL_IMAG(z_obs);
      double x_exp = GSL_REAL(z_exp);
      double y_exp = GSL_IMAG(z_exp);

      double abserr_x = fabs(x_obs - x_exp);
      double abserr_y = fabs(y_obs - y_exp);
      double noise = max * GSL_DBL_EPSILON * N * N;

      max_abserr = GSL_MAX_DBL(max_abserr, abserr_x + abserr_y);

      if (abserr_x < noise && abserr_y < noise)
        continue;

      if (abserr_x > 1.0e-6 || abserr_y > 1.0e-6)
        ++k;
    }

    if (k)
      {
        printf("==== CASE %lu ===========================\n\n", count);

        print_matrix(A, "A");

        printf("=== eval - %s ===\n", expname);
        print_vector(expected, expname);

        printf("=== eval - %s ===\n", obsname);
        print_vector(obs, obsname);

        printf("max abserr = %g  max relerr = %g\n", max_abserr, max_relerr);

        printf("=========================================\n\n");
      }

    return k;
} /* test_evals() */

/* test if A = ZTZ^t (or AZ = ZT) */

int
test_Z(gsl_matrix *A, gsl_matrix *Z, gsl_matrix *T)

{
  size_t N = A->size1;
  size_t i, j, k;
  double rhs, lhs;
  double abserr;
  gsl_matrix *T1, *T2;

  T1 = gsl_matrix_alloc(N, N);
  T2 = gsl_matrix_alloc(N, N);

  /* zero the lower triangle of T */
  if (N > 3)
    {
      for (i = 2; i < N; ++i)
        {
          for (j = 0; j < (i - 1); ++j)
            {
              gsl_matrix_set(T, i, j, 0.0);
            }
        }
    }
  else if (N == 3)
    {
      gsl_matrix_set(T, 2, 0, 0.0);
    }

  /* compute T1 = A Z */
  gsl_blas_dgemm(CblasNoTrans,
                 CblasNoTrans,
                 1.0,
                 A,
                 Z,
                 0.0,
                 T1);

  /* compute T2 = Z T */
  gsl_blas_dgemm(CblasNoTrans,
                 CblasNoTrans,
                 1.0,
                 Z,
                 T,
                 0.0,
                 T2);

  k = 0;
  for (i = 0; i < N; ++i)
    {
      for (j = 0; j < N; ++j)
        {
          lhs = gsl_matrix_get(T1, i, j);
          rhs = gsl_matrix_get(T2, i, j);

          abserr = fabs(lhs - rhs);

          if (abserr > 1.0e-6)
            ++k;
        }
    }

  if (k)
    {
      printf("==== CASE %lu ===========================\n\n", count);

      print_matrix(A, "A");

      printf("=== Schur Form matrix ===\n");
      print_matrix(T, "T");

      printf("=== Similarity matrix ===\n");
      print_matrix(Z, "Z");

      printf("=== A Z ===\n");
      print_matrix(T1, "A Z");

      printf("=== Z T ===\n");
      print_matrix(T2, "Z T");

      printf("=== A Z - Z T ===\n");
      gsl_matrix_sub(T1, T2);
      print_matrix(T1, "A Z - Z T");

      printf("=========================================\n\n");
    }

  gsl_matrix_free(T1);
  gsl_matrix_free(T2);

  return k;
} /* test_Z() */

int
test_eigenvectors(gsl_matrix *A, gsl_vector_complex *eval,
                  gsl_matrix_complex *evec)
{
  const size_t N = A->size1;
  size_t i, j;
  int k, s;
  gsl_matrix_complex *m;
  gsl_vector_complex *x, *y;
  gsl_complex z_one, z_zero;

  m = gsl_matrix_complex_alloc(N, N);
  y = gsl_vector_complex_alloc(N);
  x = gsl_vector_complex_alloc(N);

  /* m <- A */
  for (i = 0; i < N; ++i)
    {
      for (j = 0; j < N; ++j)
        {
          gsl_complex z;

          GSL_SET_COMPLEX(&z, gsl_matrix_get(A, i, j), 0.0);
          gsl_matrix_complex_set(m, i, j, z);
        }
    }

  GSL_SET_COMPLEX(&z_one, 1.0, 0.0);
  GSL_SET_COMPLEX(&z_zero, 0.0, 0.0);

  s = 0;

  /* check eigenvalues */
  for (i = 0; i < N; ++i)
    {
      gsl_vector_complex_view vi = gsl_matrix_complex_column(evec, i);
      gsl_complex ei = gsl_vector_complex_get(eval, i);
      double norm = gsl_blas_dznrm2(&vi.vector);

      /* check that eigenvector is normalized */
      gsl_test_rel(norm, 1.0, N * GSL_DBL_EPSILON, "case %u, normalized",
                   count);

      /* compute x = lambda * v */
      gsl_vector_complex_memcpy(x, &vi.vector);
      gsl_blas_zscal(ei, x);

      /* compute y = A v */
      gsl_blas_zgemv(CblasNoTrans, z_one, m, &vi.vector, z_zero, y);

      k = 0;

      /* now test if y = x */
      for (j = 0; j < N; ++j)
        {
          gsl_complex z;
          double lhs_r, lhs_i;
          double rhs_r, rhs_i;

          z = gsl_vector_complex_get(y, j);
          lhs_r = GSL_REAL(z);
          lhs_i = GSL_IMAG(z);

          z = gsl_vector_complex_get(x, j);
          rhs_r = GSL_REAL(z);
          rhs_i = GSL_IMAG(z);

          if (fabs(lhs_r - rhs_r) > 1e8 * GSL_DBL_EPSILON)
            ++k;
          if (fabs(lhs_i - rhs_i) > 1e8 * GSL_DBL_EPSILON)
            ++k;
        }

      if (k)
        {
          s++;

          printf("==== CASE %lu ===========================\n\n", count);

          print_matrix(A, "A");

          printf("eval = %f + %fi\n", GSL_REAL(ei), GSL_IMAG(ei));

          print_vector(&vi.vector, "v");

          print_vector(y, "Av");

          print_vector(x, "ev_v");

          printf("=========================================\n\n");
        }
    }

  gsl_matrix_complex_free(m);
  gsl_vector_complex_free(y);
  gsl_vector_complex_free(x);

  return s;
} /* test_eigenvectors() */

void
my_error_handler(const char *reason, const char *file, int line,
                 int err)

{
  printf("[caught: %s:%d: errno=%d %s]\n", file, line, err, reason);
} /* my_error_handler() */

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

{
  nonsymm_workspace *nonsymm_workspace_p;
  size_t N;
  int c;
  gsl_matrix *A;
  gsl_rng *r;
  int incremental; /* incremental/random matrices */
  int lower;  /* lower bound */
  int upper;  /* upper bound */
  unsigned int nmat;   /* number of matrices to solve */
  int status;
  int compute_z;
  int do_balance;

  gsl_ieee_env_setup();
  gsl_rng_env_setup();

  /*gsl_set_error_handler(&my_error_handler);*/

  N = 30;
  incremental = 0;
  compute_z = 0;
  do_balance = 0;
  lower = -10;
  upper = 10;
  nmat = 0;

  while ((c = getopt(argc, argv, "izbc:n:l:u:t:")) != (-1))
    {
      switch (c)
        {
          case 'i':
            incremental = 1;
            break;

          case 'n':
            N = strtol(optarg, NULL, 0);
            break;

          case 'l':
            lower = strtol(optarg, NULL, 0);
            break;

          case 'u':
            upper = strtol(optarg, NULL, 0);
            break;

          case 'c':
            nmat = strtoul(optarg, NULL, 0);
            break;

          case 'b':
            do_balance = 1;
            break;

          case 'z':
            compute_z = 1;
            break;

          case '?':
          default:
            printf("usage: %s [-i] [-b] [-z] [-n size] [-l lower-bound] [-u upper-bound] [-c num]\n", argv[0]);
            exit(1);
            break;
        } /* switch (c) */
    }

  A = gsl_matrix_alloc(N, N);
  nonsymm_workspace_p = nonsymm_alloc(N, compute_z, do_balance);

  if (!incremental)
    r = gsl_rng_alloc(gsl_rng_default);
  else
  {
    r = 0;
    make_start_matrix(A, lower);
  }

  fprintf(stderr, "testing N = %d", N);
  if (incremental)
    fprintf(stderr, " incrementally");
  else
    fprintf(stderr, " randomly");

  fprintf(stderr, " on element range [%d, %d]", lower, upper);

  if (compute_z)
    fprintf(stderr, ", with Schur vectors");

  if (do_balance)
    fprintf(stderr, ", with balancing");

  fprintf(stderr, "\n");

  while (1)
    {
      if (nmat && (count >= nmat))
        break;

      ++count;

      if (!incremental)
        make_random_matrix(A, r, lower, upper);
      else
        {
          status = inc_matrix(A, lower, upper);
          if (status)
            break; /* all done */
        }

      /* make copies of the matrix */
      gsl_matrix_memcpy(nonsymm_workspace_p->A, A);
      gsl_matrix_memcpy(nonsymm_workspace_p->Av, A);

      status = nonsymm_proc(nonsymm_workspace_p);

      if (status)
        {
          printf("=========== CASE %lu ============\n", count);
          printf("Failed to converge: found %u eigenvalues\n",
                 nonsymm_workspace_p->n_evals);
          print_matrix(A, "A");
        }

      gsl_eigen_nonsymmv_sort(nonsymm_workspace_p->evalv,
                              nonsymm_workspace_p->evec,
                              GSL_EIGEN_SORT_ABS_ASC);

      status = test_eigenvectors(A,
                                 nonsymm_workspace_p->evalv,
                                 nonsymm_workspace_p->evec);

      sort_complex_vector(nonsymm_workspace_p->eval);
      sort_complex_vector(nonsymm_workspace_p->evalv);

      status = test_evals(nonsymm_workspace_p->eval,
                          nonsymm_workspace_p->evalv,
                          A,
                          "nonsymm",
                          "nonsymmv");

      if (compute_z)
        {
          test_Z(A, nonsymm_workspace_p->Z, nonsymm_workspace_p->A);
          test_Z(A, nonsymm_workspace_p->Zv, nonsymm_workspace_p->Av);
        }
    }

  gsl_matrix_free(A);
  nonsymm_free(nonsymm_workspace_p);

  if (r)
    gsl_rng_free(r);

  return 0;
} /* main() */


#define _GNU_SOURCE
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <time.h>
#include <sys/time.h>
#include <sys/resource.h>
#include <unistd.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_integration.h>

#include "../core_allvars.h"

#define LUV_LOOKUPTABLE_MASS 1e6

int32_t init_UVlookup(void)
{

  // For calcUVmag == 1 we must explicitly track the stellar ages of a galaxy.
  // Then we determine the UV magnitude using the age of the stellar population.

  // Using STARBURST99 it was determined that the 1600A Luminosty depends on the mass
  // of stars formed and the time since the starburst. Furthermore, the UV luminosity linearly with the mass of stars formed.
  // That is, a starburst that forms 6.0e11Msun worth of stars will exhibit 10 times the UV luminosity as a starburst that forms 6.0e10Msun worth of stars.

  // So if we read in a table that contains the number of ionizing photons emitted from a starburst for a 6.0e10Msun episode, then we can scale our values to this lookup table
  // using log10 LUV(Msun, t) = (log10 M* - 6.0) + log10 LUV(6.0, t).

#define MAXBINS 10000

  char fname[MAX_STRING_LEN];
  FILE *LUVtable;
  int32_t num_lines = 0;
  float t, lambda, LUV, norm_spec;

  snprintf(fname, MAX_STRING_LEN - 1, ROOT_DIR "/extra/LUV_table.txt");
  LUVtable = fopen(fname, "r");
  if (LUVtable == NULL)
  {
    fprintf(stderr, "Could not open file %s\n", fname);
    return EXIT_FAILURE;
  }

  stars_LUV = calloc(MAXBINS, sizeof(*(stars_LUV)));
  if (stars_LUV == NULL)
  {
    fprintf(stderr, "Could not allocate memory for the UV luminosity bins for the tracking of stellar populations.\n");
    return EXIT_FAILURE;
  }

  while (fscanf(LUVtable, "%f %f %f %f", &t, &lambda, &LUV, &norm_spec) == 4)
  {

    stars_LUV[num_lines] = LUV;

    ++num_lines;
    if (num_lines == MAXBINS - 1)
    {
      fprintf(stderr, "Exceeding the maximum bins for the tracking of stellar populations.\n");
      return EXIT_FAILURE;
    }
  }
  fclose(LUVtable);

  // Check that the Nion lookup table had enough datapoints to cover the time we're tracking the ages for.
  if (t / 1.0e6 < STELLAR_TRACKING_TIME)
  {
    fprintf(stderr, "The final time specified in the UV luminosity lookup table is %.4f Myr. However we specified to track stellar ages over %d Myr.\n", t / 1.0e6, STELLAR_TRACKING_TIME);
    fprintf(stderr, "Either update the UV luminosity lookup table or reduce the value of STELLAR_TRACKING_TIME in `core_allvars.h`.\n");
    return EXIT_FAILURE;
  }

  return EXIT_SUCCESS;

#undef MAXBINS
}

/*
Calculates the UV Luminosity (i.e., at 1600A) for a given galaxy at a specified snapshot.

**Important** See Units.

Parameters
----------

g: struct GALAXY pointer.  See `core_allvars.h` for the struct architecture.
  Pointer to the galaxy that we are calculating UV luminosity.

*LUV: Float Pointer.
  Pointer that will store the UV luminosity.

Returns
----------

EXIT_SUCCESS or EXIT_FAILURE.
  If the UV luminosity is negative, EXIT_FAILURE is returned.  Otherwise EXIT_SUCCESS is returned.

Pointer Updates
----------

*LUV.

Units
----------

The UV luminosty is returned in units of 1.0e50 erg s^-1 A^-1
*/

int32_t calc_LUV(struct GALAXY *g, float *LUV)
{

  double t;
  int32_t i, lookup_idx;

  // We ran STARBURST99 for a single mass and scale our results.
  // First convert the mass to internal code units.
  const double code_LUV_lookuptable_mass = LUV_LOOKUPTABLE_MASS*1.0e-10*Hubble_h;

  *LUV = 0.0;

  // Then go through the previous 100Myr worth of SF and sum up the UV luminosity.
  for (i = 0; i < StellarTracking_Len - 1; ++i)
  {
    if (g->Stellar_Stars[i] < 1e-10)
      continue;

    t = (i + 1) * TimeResolutionStellar; // (i + 1) because 0th entry will be at TimeResolutionSN.
    lookup_idx = t; // Find the index in the lookup table.

    *LUV += exp10(log10(g->Stellar_Stars[i] / code_LUV_lookuptable_mass) + stars_LUV[lookup_idx] - 50.0);
    //printf("t %.4f\tlookup_idx %d\tg->Stellar_Stars[i] %.4e\tstars_LUV[lookup_idx] %.4e\tRunningTotal %.4e\n", t, lookup_idx, g->Stellar_Stars[i], stars_LUV[lookup_idx], *LUV);
  }

  // The units of LUV are 1.0e50 erg s^-1 A^-1.  Hence a negative value is not allowed.
  if (*LUV < 0.0)
  {
    fprintf(stderr, "Got an LUV value of %.4e.  This MUST be a positive value.\nPrinting out information for every element used to calculate LUV.\n", *LUV);

    // Print out information for every element of the array so we can try identify the problem.
    for (i = 0; i < StellarTracking_Len; ++i)
    {
      t = (i + 1) * TimeResolutionStellar; // (i + 1) because 0th entry will be at TimeResolutionSN.
      lookup_idx = (t / 0.1); // Find the index in the lookup table.

      double total = 0.0;
      total += exp10(log10(g->Stellar_Stars[i] / code_LUV_lookuptable_mass) + stars_LUV[lookup_idx] - 50.0);
      printf("t %.4f\tlookup_idx %d\tg->Stellar_Stars[i] %.4e\tstars_LUV[lookup_idx] %.4e\tRunningTotal %.4e\n", t, lookup_idx, g->Stellar_Stars[i], stars_LUV[lookup_idx], total);
    }
    return EXIT_FAILURE;
  }

  return EXIT_SUCCESS;
}


// The MIT License (MIT)
//
// Copyright (c) 2018 Mateusz Pusz
//
// Permission is hereby granted, free of charge, to any person obtaining a copy
// of this software and associated documentation files (the "Software"), to deal
// in the Software without restriction, including without limitation the rights
// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
// copies of the Software, and to permit persons to whom the Software is
// furnished to do so, subject to the following conditions:
//
// The above copyright notice and this permission notice shall be included in all
// copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
// SOFTWARE.

#pragma once

#include <gsl/gsl-lite.hpp>
#include <units/bits/constexpr_math.h>
#include <units/bits/math_concepts.h>
#include <units/bits/pow.h>
#include <units/bits/ratio_maths.h>
#include <cmath>

namespace units::detail {

template<std::intmax_t N, typename F>
  requires gt_zero<N>
[[nodiscard]] constexpr std::intmax_t iroot_impl(std::intmax_t v, F const& pow_function) noexcept
{
  if constexpr (N == 1) {
    return v;
  } else {
    gsl_Expects(v >= 0);
    if (v == 0) {
      return 0;
    }

    constexpr double exponent = 1.0 / static_cast<double>(N);
    const auto root = static_cast<std::intmax_t>(pow_function(static_cast<double>(v), exponent));

    // integer roots may be truncated down by 1 or in even rarer cases up by 1 due to finite precision of pow and
    // exponent, check both cases
    if (v == pow_impl<N>(root + 1)) {
      return root + 1;
    }
    if (v < pow_impl<N>(root)) {
      return root - 1;
    }
    return root;
  }
}

// maximum v is std::numeric_limits<std::intmax_t>::max() which is the worst case for exp convergence
// ExpOrder = 12 and Factor = 64 give a precision of about O(1e-15) for a wide range of 1 / N exponents
// Factor = 32 needs quite a few more terms to converge
// https://godbolt.org/z/odWq1o
template<std::intmax_t N, std::size_t ExpOrder = 12, std::intmax_t Factor = 64>
  requires gt_zero<N>
[[nodiscard]] constexpr std::intmax_t iroot_compile(std::intmax_t v) noexcept
{
  return iroot_impl<N>(v, [](double x, double exponent) { return constexpr_pow<ExpOrder, Factor>(x, exponent); });
}

template<std::intmax_t N>
  requires gt_zero<N>
[[nodiscard]] std::intmax_t iroot_runtime(std::intmax_t v) noexcept
{
  return iroot_impl<N>(v, [](double x, [[maybe_unused]] double exponent) {
    if constexpr (N == 2) {
      return std::sqrt(x);
    } else if constexpr (N == 3) {
      return std::cbrt(x);
    } else {
      return std::pow(x, exponent);
    }
  });
}

template<std::intmax_t N>
  requires gt_zero<N>
[[nodiscard]] constexpr std::intmax_t iroot(std::intmax_t v) noexcept
{
  // compile time version is much slower, use faster version at runtime
  if (std::is_constant_evaluated()) {
    return iroot_compile<N>(v);
  }

  return iroot_runtime<N>(v);
}

}  // namespace units::detail


#include <gsl/gsl_vector.h>
#include <gsl/gsl_multiroots.h>


#include <math.h>
#include <stdio.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <Python.h>
int sum(int* npyArray3D, int npyLength1D, int npyLength2D, int npyLength3D)
{
  int i, j, k;
  int sum = 0;
  double dummy = sqrt(9.0);
  int MAT_DIM = 6;

  gsl_matrix *m = gsl_matrix_alloc(MAT_DIM, MAT_DIM);
  for (i=0; i < MAT_DIM*MAT_DIM; i++) {
    gsl_matrix_set (m, i%MAT_DIM, i/MAT_DIM, (double) npyArray3D[i]);
  }

  for (i=0; i < MAT_DIM*MAT_DIM; i++) {
    printf("%f, ", gsl_matrix_get (m, i%MAT_DIM, i/MAT_DIM));
  }
  printf("\n");

  for (i=0;i<npyLength1D;i++)
    for (j=0;j<npyLength2D;j++)
      for (k=0;k<npyLength3D;k++)
        sum += npyArray3D[i*npyLength3D*npyLength2D + k*npyLength2D + j];

  printf("%f\n",dummy);
  return sum;
}

double get_det(PyObject *A)
{
  int MAT_DIM = 6;
  int i, signum;
  double det;
  int nInts = PyList_Size(A);

  gsl_matrix *m = gsl_matrix_alloc(MAT_DIM, MAT_DIM);
  gsl_permutation *p;

  p = gsl_permutation_alloc(m->size1);

  for (i=0; i<nInts; i++)
  {
    PyObject *oo = PyList_GetItem(A, i);
    gsl_matrix_set (m, i%MAT_DIM, i/MAT_DIM, PyFloat_AS_DOUBLE(oo));
  }

  gsl_linalg_LU_decomp(m, p, &signum);
  det = gsl_linalg_LU_det(m, signum);

  return det;
}


/**
 *
 * @file core_cgetf2_nopiv.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Omar Zenati
 * @author Mathieu Faverge
 * @date 2013-02-01
 * @generated c Tue Jan  7 11:44:50 2014
 *
 **/
#include "common.h"
#include <math.h>
#include <lapacke.h>

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex32_t
 *
 *  CORE_cgetf2_nopiv computes an LU factorization of a general diagonal
 *  dominant M-by-N matrix A witout no pivoting and no blocking. It is the
 *  internal function called by CORE_cgetrf_nopiv().
 *
 *  The factorization has the form
 *     A = L * U
 *  where L is lower triangular with unit
 *  diagonal elements (lower trapezoidal if m > n), and U is upper
 *  triangular (upper trapezoidal if m < n).
 *
 *  This is the right-looking Level 3 BLAS version of the algorithm.
 *
 *******************************************************************************
 *
 *  @param[in] M
 *          The number of rows of the matrix A.  M >= 0.
 *
 *  @param[in] N
 *          The number of columns of the matrix A.  N >= 0.
 *
 *  @param[in,out] A
 *          On entry, the M-by-N matrix to be factored.
 *          On exit, the factors L and U from the factorization
 *          A = P*L*U; the unit diagonal elements of L are not stored.
 *
 *  @param[in] LDA
 *          The leading dimension of the array A.  LDA >= max(1,M).
 *
 *******************************************************************************
 *
 * @return
 *         \retval PLASMA_SUCCESS successful exit
 *         \retval <0 if INFO = -k, the k-th argument had an illegal value
 *         \retval >0 if INFO = k, U(k,k) is exactly zero. The factorization
 *              has been completed, but the factor U is exactly
 *              singular, and division by zero will occur if it is used
 *              to solve a system of equations.
 *
 ******************************************************************************/
int
CORE_cgetf2_nopiv(int M, int N,
                  PLASMA_Complex32_t *A, int LDA)
{
    PLASMA_Complex32_t mzone = (PLASMA_Complex32_t)-1.0;
    PLASMA_Complex32_t alpha;
    float sfmin;
    int i, j, k;
    int info;

    /* Check input arguments */
    info = 0;
    if (M < 0) {
        coreblas_error(1, "Illegal value of M");
        return -1;
    }
    if (N < 0) {
        coreblas_error(2, "Illegal value of N");
        return -2;
    }
    if ((LDA < max(1,M)) && (M > 0)) {
        coreblas_error(5, "Illegal value of LDA");
        return -5;
    }

    /* Quick return */
    if ( (M == 0) || (N == 0) )
        return PLASMA_SUCCESS;

    sfmin = LAPACKE_slamch_work('S');
    k = min(M, N);
    for(i=0 ; i < k; i++) {
        alpha = A[i*LDA+i];
        if ( alpha != (PLASMA_Complex32_t)0.0 ) {
            /* Compute elements J+1:M of J-th column. */
            if (i < M) {
                if ( cabsf(alpha) > sfmin ) {
                    alpha = 1.0 / alpha;
                    cblas_cscal( M-i-1, CBLAS_SADDR(alpha), &(A[i*LDA+i+1]), 1);
                } else {
                    for(j=i+1; j<M; j++)
                        A[LDA*i+j] = A[LDA*i+j] / alpha;
                }
            }
        } else if ( info == 0 ) {
            info = i;
            goto end;
        }

        if ( i < k ) {
            /* Update trailing submatrix */
            cblas_cgeru(CblasColMajor,
                        M-i-1, N-i-1, CBLAS_SADDR(mzone),
                        &A[LDA* i   +i+1], 1,
                        &A[LDA*(i+1)+i  ], LDA,
                        &A[LDA*(i+1)+i+1], LDA);
        }
    }

 end:
    return info;
}


//This gets polynomial coeffs for each row/col of X using the Burg method.

//An opt mean0 is added to zero the mean of each row/col of X first.
//In this case, this is mean0 -> autocov_fft -> sig2ar_burg.

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <cblas.h>

#ifdef __cplusplus
namespace codee {
extern "C" {
#endif

int sig2ar_burg_s (float *Y, float *V, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t P, const int mean0);
int sig2ar_burg_d (double *Y, double *V, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t P, const int mean0);

int sig2ar_burg_s (float *Y, float *V, const float *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t P, const int mean0)
{
    if (dim>3) { fprintf(stderr,"error in sig2ar_burg_s: dim must be in [0 3]\n"); return 1; }

    const float o = 1.0f;
    const int N = (dim==0) ? R : C;
    int r, c, p, q;
    float m, g, b2, f2;
    float *b, *f, *oldf, *AStmp;

    //Checks
    if (R<1) { fprintf(stderr,"error in sig2ar_burg_s: nrows X must be positive\n"); return 1; }
    if (C<1) { fprintf(stderr,"error in sig2ar_burg_s: ncols X must be positive\n"); return 1; }
    if (dim==0 && P>=R) { fprintf(stderr,"error in sig2ar_burg_s: P must be < nrows X for dim==0\n"); return 1; }
    if (dim==1 && P>=C) { fprintf(stderr,"error in sig2ar_burg_s: P must be < ncols X for dim==1\n"); return 1; }

    //Allocate
    if (!(b=(float *)malloc((size_t)(N)*sizeof(float)))) { fprintf(stderr,"error in sig2ar_burg_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(f=(float *)malloc((size_t)(N)*sizeof(float)))) { fprintf(stderr,"error in sig2ar_burg_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(oldf=(float *)malloc((size_t)(N)*sizeof(float)))) { fprintf(stderr,"error in sig2ar_burg_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(AStmp=(float *)malloc((size_t)(P)*sizeof(float)))) { fprintf(stderr,"error in sig2ar_burg_s: problem with malloc. "); perror("malloc"); return 1; }

    if (dim==0)
    {
        if (iscolmajor)
        {
            for (size_t c=0; c<C; c++)
            {
                cblas_scopy((int)R,&X[c*R],1,b,1);
                if (mean0)
                {
                    m = cblas_sdot((int)R,b,1,&o,0) / R;
                    cblas_saxpy((int)R,-m,&o,0,b,1);
                }
                cblas_scopy((int)R,b,1,f,1);
                V[c] = cblas_sdot((int)R,b,1,f,1) / R;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_sdot(R-p,b,1,b,1);
                    f2 = cblas_sdot(R-p,&f[p],1,&f[p],1);
                    Y[c*P+p-1] = g = (-2.0f/(b2+f2)) * cblas_sdot(R-p,b,1,&f[p],1);
                    V[c] *= fmaf(g,-g,1.0f);
                    if (p>1) { for (q=0; q<p; q++) { Y[c*P+q] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_scopy(p,&Y[c*P],1,AStmp,1);
                        cblas_scopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_saxpy(N-p,g,b,1,&f[p],1);
                        cblas_saxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        else
        {
            for (size_t c=0; c<C; c++)
            {
                cblas_scopy((int)R,&X[c],(int)C,b,1);
                if (mean0)
                {
                    m = cblas_sdot((int)R,b,1,&o,0) / R;
                    cblas_saxpy((int)R,-m,&o,0,b,1);
                }
                cblas_scopy((int)R,b,1,f,1);
                V[c] = cblas_sdot((int)R,b,1,f,1) / R;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_sdot(R-p,b,1,b,1);
                    f2 = cblas_sdot(R-p,&f[p],1,&f[p],1);
                    Y[c+(p-1)*C] = g = (-2.0f/(b2+f2)) * cblas_sdot(R-p,b,1,&f[p],1);
                    V[c] *= fmaf(g,-g,1.0f);
                    if (p>1) { for (q=0; q<p; q++) { Y[c+q*C] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_scopy(p,&Y[c],(int)C,AStmp,1);
                        cblas_scopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_saxpy(N-p,g,b,1,&f[p],1);
                        cblas_saxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        cblas_sscal(P*C,-1.0f,Y,1);
    }
    else if (dim==1)
    {
        if (iscolmajor)
        {
            for (size_t r=0; r<R; r++)
            {
                cblas_scopy((int)C,&X[r],(int)R,b,1);
                if (mean0)
                {
                    m = cblas_sdot((int)C,b,1,&o,0) / C;
                    cblas_saxpy((int)C,-m,&o,0,b,1);
                }
                cblas_scopy((int)C,b,1,f,1);
                V[r] = cblas_sdot((int)C,b,1,f,1) / C;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_sdot(C-p,b,1,b,1);
                    f2 = cblas_sdot(C-p,&f[p],1,&f[p],1);
                    Y[r+(p-1)*R] = g = (-2.0f/(b2+f2)) * cblas_sdot(C-p,b,1,&f[p],1);
                    V[r] *= fmaf(g,-g,1.0f);
                    if (p>1) { for (q=0; q<p; q++) { Y[r+q*R] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_scopy(p,&Y[r],(int)R,AStmp,1);
                        cblas_scopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_saxpy(N-p,g,b,1,&f[p],1);
                        cblas_saxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        else
        {
            for (size_t r=0; r<R; r++)
            {
                cblas_scopy((int)C,&X[r*C],1,b,1);
                if (mean0)
                {
                    m = cblas_sdot((int)C,b,1,&o,0) / C;
                    cblas_saxpy((int)C,-m,&o,0,b,1);
                }
                cblas_scopy((int)C,b,1,f,1);
                V[r] = cblas_sdot((int)C,b,1,f,1) / C;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_sdot(C-p,b,1,b,1);
                    f2 = cblas_sdot(C-p,&f[p],1,&f[p],1);
                    Y[r*P+p-1] = g = (-2.0f/(b2+f2)) * cblas_sdot(C-p,b,1,&f[p],1);
                    V[r] *= fmaf(g,-g,1.0f);
                    if (p>1) { for (q=0; q<p; q++) { Y[r*P+q] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_scopy(p,&Y[r*P],1,AStmp,1);
                        cblas_scopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_saxpy(N-p,g,b,1,&f[p],1);
                        cblas_saxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        cblas_sscal(R*P,-1.0f,Y,1);
    }
    else
    {
        fprintf(stderr,"error in sig2ar_burg_s: dim must be 0 or 1.\n"); return 1;
    }

    //Exit
    free(b); free(f); free(oldf); free(AStmp);
    return 0;
}

int sig2ar_burg_d (double *Y, double *V, const double *X, const size_t R, const size_t C, const size_t S, const size_t H, const int iscolmajor, const size_t dim, const size_t P, const int mean0)
{
    if (dim>3) { fprintf(stderr,"error in sig2ar_burg_d: dim must be in [0 3]\n"); return 1; }

    const double o = 1.0;
    const int N = (dim==0) ? R : C;
    int r, c, p, q;
    double m, g, b2, f2;
    double *b, *f, *oldf, *AStmp;

    //Checks
    if (R<1) { fprintf(stderr,"error in sig2ar_burg_d: nrows X must be positive\n"); return 1; }
    if (C<1) { fprintf(stderr,"error in sig2ar_burg_d: ncols X must be positive\n"); return 1; }
    if (dim==0 && P>=R) { fprintf(stderr,"error in sig2ar_burg_d: P must be < nrows X for dim==0\n"); return 1; }
    if (dim==1 && P>=C) { fprintf(stderr,"error in sig2ar_burg_d: P must be < ncols X for dim==1\n"); return 1; }

    //Allocate
    if (!(b=(double *)malloc((size_t)(N)*sizeof(double)))) { fprintf(stderr,"error in sig2ar_burg_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(f=(double *)malloc((size_t)(N)*sizeof(double)))) { fprintf(stderr,"error in sig2ar_burg_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(oldf=(double *)malloc((size_t)(N)*sizeof(double)))) { fprintf(stderr,"error in sig2ar_burg_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(AStmp=(double *)malloc((size_t)(P)*sizeof(double)))) { fprintf(stderr,"error in sig2ar_burg_d: problem with malloc. "); perror("malloc"); return 1; }

    if (dim==0)
    {
        if (iscolmajor)
        {
            for (size_t c=0; c<C; c++)
            {
                cblas_dcopy((int)R,&X[c*R],1,b,1);
                if (mean0)
                {
                    m = cblas_ddot((int)R,b,1,&o,0) / R;
                    cblas_daxpy((int)R,-m,&o,0,b,1);
                }
                cblas_dcopy((int)R,b,1,f,1);
                V[c] = cblas_ddot((int)R,b,1,f,1) / R;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_ddot(R-p,b,1,b,1);
                    f2 = cblas_ddot(R-p,&f[p],1,&f[p],1);
                    Y[c*P+p-1] = g = (-2.0/(b2+f2)) * cblas_ddot(R-p,b,1,&f[p],1);
                    V[c] *= fma(g,-g,1.0);
                    if (p>1) { for (q=0; q<p; q++) { Y[c*P+q] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_dcopy(p,&Y[c*P],1,AStmp,1);
                        cblas_dcopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_daxpy(N-p,g,b,1,&f[p],1);
                        cblas_daxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        else
        {
            for (size_t c=0; c<C; c++)
            {
                cblas_dcopy((int)R,&X[c],(int)C,b,1);
                if (mean0)
                {
                    m = cblas_ddot((int)R,b,1,&o,0) / R;
                    cblas_daxpy((int)R,-m,&o,0,b,1);
                }
                cblas_dcopy((int)R,b,1,f,1);
                V[c] = cblas_ddot((int)R,b,1,f,1) / R;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_ddot(R-p,b,1,b,1);
                    f2 = cblas_ddot(R-p,&f[p],1,&f[p],1);
                    Y[c+(p-1)*C] = g = (-2.0/(b2+f2)) * cblas_ddot(R-p,b,1,&f[p],1);
                    V[c] *= fma(g,-g,1.0);
                    if (p>1) { for (q=0; q<p; q++) { Y[c+q*C] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_dcopy(p,&Y[c],(int)C,AStmp,1);
                        cblas_dcopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_daxpy(N-p,g,b,1,&f[p],1);
                        cblas_daxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        cblas_dscal(P*C,-1.0,Y,1);
    }
    else if (dim==1)
    {
        if (iscolmajor)
        {
            for (size_t r=0; r<R; r++)
            {
                cblas_dcopy((int)C,&X[r],(int)R,b,1);
                if (mean0)
                {
                    m = cblas_ddot((int)C,b,1,&o,0) / C;
                    cblas_daxpy((int)C,-m,&o,0,b,1);
                }
                cblas_dcopy((int)C,b,1,f,1);
                V[r] = cblas_ddot((int)C,b,1,f,1) / C;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_ddot(C-p,b,1,b,1);
                    f2 = cblas_ddot(C-p,&f[p],1,&f[p],1);
                    Y[r+(p-1)*R] = g = (-2.0/(b2+f2)) * cblas_ddot(C-p,b,1,&f[p],1);
                    V[r] *= fma(g,-g,1.0);
                    if (p>1) { for (q=0; q<p; q++) { Y[r+q*R] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_dcopy(p,&Y[r],(int)R,AStmp,1);
                        cblas_dcopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_daxpy(N-p,g,b,1,&f[p],1);
                        cblas_daxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        else
        {
            for (size_t r=0; r<R; r++)
            {
                cblas_dcopy((int)C,&X[r*C],1,b,1);
                if (mean0)
                {
                    m = cblas_ddot((int)C,b,1,&o,0) / C;
                    cblas_daxpy((int)C,-m,&o,0,b,1);
                }
                cblas_dcopy((int)C,b,1,f,1);
                V[r] = cblas_ddot((int)C,b,1,f,1) / C;
                for (p=1; p<=P; p++)
                {
                    b2 = cblas_ddot(C-p,b,1,b,1);
                    f2 = cblas_ddot(C-p,&f[p],1,&f[p],1);
                    Y[r*P+p-1] = g = (-2.0/(b2+f2)) * cblas_ddot(C-p,b,1,&f[p],1);
                    V[r] *= fma(g,-g,1.0);
                    if (p>1) { for (q=0; q<p; q++) { Y[r*P+q] += g * AStmp[p-q-2]; } }
                    if (p<P)
                    {
                        cblas_dcopy(p,&Y[r*P],1,AStmp,1);
                        cblas_dcopy(N-p,&f[p],1,&oldf[p],1);
                        cblas_daxpy(N-p,g,b,1,&f[p],1);
                        cblas_daxpy(N-p,g,&oldf[p],1,b,1);
                    }
                }
            }
        }
        cblas_dscal(R*P,-1.0,Y,1);
    }
    else
    {
        fprintf(stderr,"error in sig2ar_burg_d: dim must be 0 or 1.\n"); return 1;
    }

    //Exit
    free(b); free(f); free(oldf); free(AStmp);
    return 0;
}

#ifdef __cplusplus
}
}
#endif


/* monte/plain.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Michael Booth
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
 */

/* Plain Monte-Carlo. */

/* Author: MJB */

#include <config.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_monte_plain.h>

int
gsl_monte_plain_integrate (const gsl_monte_function * f,
                           const double xl[], const double xu[],
                           const size_t dim,
                           const size_t calls,
                           gsl_rng * r,
                           gsl_monte_plain_state * state,
                           double *result, double *abserr)
{
  double vol, m = 0, q = 0;
  double *x = state->x;
  size_t n, i;

  if (dim != state->dim)
    {
      GSL_ERROR ("number of dimensions must match allocated size", GSL_EINVAL);
    }

  for (i = 0; i < dim; i++)
    {
      if (xu[i] <= xl[i])
        {
          GSL_ERROR ("xu must be greater than xl", GSL_EINVAL);
        }

      if (xu[i] - xl[i] > GSL_DBL_MAX)
        {
          GSL_ERROR ("Range of integration is too large, please rescale",
                     GSL_EINVAL);
        }
    }

  /* Compute the volume of the region */

  vol = 1;

  for (i = 0; i < dim; i++)
    {
      vol *= xu[i] - xl[i];
    }

  for (n = 0; n < calls; n++)
    {
      /* Choose a random point in the integration region */

      for (i = 0; i < dim; i++)
        {
          x[i] = xl[i] + gsl_rng_uniform_pos (r) * (xu[i] - xl[i]);
        }

      {
        double fval = GSL_MONTE_FN_EVAL (f, x);

        /* recurrence for mean and variance */

        double d = fval - m;
        m += d / (n + 1.0);
        q += d * d * (n / (n + 1.0));
      }
    }

  *result = vol * m;

  if (calls < 2)
    {
      *abserr = GSL_POSINF;
    }
  else
    {
      *abserr = vol * sqrt (q / (calls * (calls - 1.0)));
    }

  return GSL_SUCCESS;
}

gsl_monte_plain_state *
gsl_monte_plain_alloc (size_t dim)
{
  gsl_monte_plain_state *s =
    (gsl_monte_plain_state *) malloc (sizeof (gsl_monte_plain_state));

  if (s == 0)
    {
      GSL_ERROR_VAL ("failed to allocate space for state struct",
                     GSL_ENOMEM, 0);
    }

  s->x = (double *) malloc (dim * sizeof (double));

  if (s->x == 0)
    {
      free (s);
      GSL_ERROR_VAL ("failed to allocate space for working vector",
                     GSL_ENOMEM, 0);
    }

  s->dim = dim;

  return s;
}

/* Set some default values and whatever */

int
gsl_monte_plain_init (gsl_monte_plain_state * s)
{
  size_t i;

  for (i = 0; i < s->dim; i++)
    {
      s->x[i] = 0.0;
    }

  return GSL_SUCCESS;
}

void
gsl_monte_plain_free (gsl_monte_plain_state * s)
{
  free (s->x);
  free (s);
}