/* specfunc/gsl_sf_erf.h
 *
 * 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 */

#ifndef __GSL_SF_ERF_H__
#define __GSL_SF_ERF_H__

#include <gsl/gsl_sf_result.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

/* Complementary Error Function
 * erfc(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,x,Infinity}]
 *
 * exceptions: none
 */
int gsl_sf_erfc_e(double x, gsl_sf_result * result);
double gsl_sf_erfc(double x);

/* Log Complementary Error Function
 *
 * exceptions: none
 */
int gsl_sf_log_erfc_e(double x, gsl_sf_result * result);
double gsl_sf_log_erfc(double x);

/* Error Function
 * erf(x) := 2/Sqrt[Pi] Integrate[Exp[-t^2], {t,0,x}]
 *
 * exceptions: none
 */
int gsl_sf_erf_e(double x, gsl_sf_result * result);
double gsl_sf_erf(double x);

/* Probability functions:
 * Z(x) :  Abramowitz+Stegun 26.2.1
 * Q(x) :  Abramowitz+Stegun 26.2.3
 *
 * exceptions: none
 */
int gsl_sf_erf_Z_e(double x, gsl_sf_result * result);
int gsl_sf_erf_Q_e(double x, gsl_sf_result * result);
double gsl_sf_erf_Z(double x);
double gsl_sf_erf_Q(double x);

/* Hazard function, also known as the inverse Mill's ratio.
 *
 *   H(x) := Z(x)/Q(x)
 *         = Sqrt[2/Pi] Exp[-x^2 / 2] / Erfc[x/Sqrt[2]]
 *
 * exceptions: GSL_EUNDRFLW
 */
int gsl_sf_hazard_e(double x, gsl_sf_result * result);
double gsl_sf_hazard(double x);

__END_DECLS

#endif /* __GSL_SF_ERF_H__ */


/*****************************************************************************
*
* Rokko: Integrated Interface for libraries of eigenvalue decomposition
*
* Copyright (C) 2012-2014 by Synge Todo <wistaria@phys.s.u-tokyo.ac.jp>
*
* Distributed under the Boost Software License, Version 1.0. (See accompanying
* file LICENSE_1_0.txt or copy at http://www.boost.org/LICENSE_1_0.txt)
*
*****************************************************************************/

#include <stdlib.h>
#include <stdio.h>
#include <lapacke.h>

#define N 5

int main() {
  int i, j, info;
  double w[N];
  double a[N][N] = {
    5, 4, 3, 2, 1,
    4, 4, 3, 2, 1,
    3, 3, 3, 2, 1,
    2, 2, 2, 2, 1,
    1, 1, 1, 1, 1
  };
  info = LAPACKE_dsyev(LAPACK_ROW_MAJOR, 'V', 'U', N, a[0], N, w);
  printf("Eigenvalues of Frank matrix: ");
  for (i = 0; i < N; ++i) {
    printf(" %6.2f", w[i]);
  }
  printf("\n");
  printf("Eigenvectors of Frank matrix (column by column):\n");
  for (i = 0; i < N; ++i) {
    for (j = 0; j < N; ++j) {
      printf(" %6.2f", a[i][j]);
    }
    printf("\n");
  }
  return 0;
}


#include <gsl/gsl_spmatrix.h>
#include <munit.h>
#include <osqp/cs.h>
#include <osqp/osqp.h>
#include <unistd.h>

#include <qdm.h>

#include "test.h"

static
MunitResult
test_qdm_vector_seq(
    const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  double min = atof(munit_parameters_get(params, "qdm_vector_seq_min"));
  double max = atof(munit_parameters_get(params, "qdm_vector_seq_max"));
  double delta = atof(munit_parameters_get(params, "qdm_vector_seq_delta"));

  if (min >= max) {
    return MUNIT_SKIP;
  }

  gsl_vector *seq = qdm_vector_seq(min, max, delta);

  munit_assert_size(((max - min) / delta) + 1, ==, seq->size);

  for (size_t i = 0; i < seq->size; i++) {
    double expecting = min + delta * i;
    double found = gsl_vector_get(seq, i);

    munit_logf(MUNIT_LOG_DEBUG, "%.17g", found);
    munit_assert_double_equal(expecting, found, 3);
  }

  return MUNIT_OK;
}

static
MunitResult
test_qdm_vector_set_seq(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  gsl_vector *seq = gsl_vector_alloc(10);

  qdm_vector_set_seq(seq, 0, 9);

  for (size_t i = 0; i < seq->size; i++) {
    double expecting = (double)i;
    double found = gsl_vector_get(seq, i);

    munit_logf(MUNIT_LOG_DEBUG, "e %.17g f %.17g", expecting, found);
    munit_assert_double_equal(expecting, found, 3);
  }

  qdm_vector_set_seq(seq, 9, 0);

  for (size_t i = 0; i < seq->size; i--) {
    double expecting = (double)(9 - i);
    double found = gsl_vector_get(seq, i);

    munit_logf(MUNIT_LOG_DEBUG, "e %.17g f %.17g", expecting, found);
    munit_assert_double_equal(expecting, found, 3);
  }

  qdm_vector_set_seq(seq, 0, 1);
  double data[10] = {
    0.0,
    0.1,
    0.2,
    0.3,
    0.4,
    0.5,
    0.6,
    0.7,
    0.8,
    0.9,
  };

  for (size_t i = 0; i < seq->size; i--) {
    double expecting = data[i];
    double found = gsl_vector_get(seq, i);

    munit_logf(MUNIT_LOG_DEBUG, "e %.17g f %.17g", expecting, found);
    munit_assert_double_equal(expecting, found, 3);
  }

  return MUNIT_OK;
}

static
MunitResult
test_qdm_matrix_det_tmm(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  int status = 0;

  /* Zero */
  double data_zero[4][3] = {
      {1,1,1},
      {2,2,2},
      {3,3,3},
      {4,4,4},
  };

  gsl_matrix_view m = gsl_matrix_view_array((double *)data_zero, 4, 3);

  double det_zero = 0;
  status = qdm_matrix_det_tmm(&m.matrix, &det_zero);
  munit_assert_int(status, ==, 0);
  munit_assert_double_equal(0, det_zero, 3);

  /* Non-zero */
  double data_nonzero[4][3] = {
      {1,2,3},
      {4,5,2},
      {1,1,3},
      {1,1,4},
  };

  m = gsl_matrix_view_array((double *)data_nonzero, 4, 3);

  double det_nonzero = 0;
  status = qdm_matrix_det_tmm(&m.matrix, &det_nonzero);
  munit_assert_int(status, ==, 0);
  munit_assert_double_equal(271, det_nonzero, 3);

  return MUNIT_OK;
}

static
MunitResult
test_qdm_vector_quantile(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  /* Basic */
  double data[10] = {
    1,
    2,
    3,
    4,
    5,
    6,
    7,
    8,
    9,
    10,
  };

  gsl_vector_view v = gsl_vector_view_array((double *)data, 10);
  gsl_vector *probs = qdm_vector_seq(0, 1, 0.25);
  gsl_vector *quantiles = qdm_vector_quantile(&v.vector, probs);

  munit_log(MUNIT_LOG_DEBUG, "basic");
  munit_log_vector(MUNIT_LOG_DEBUG, &v.vector);
  munit_log_vector(MUNIT_LOG_DEBUG, probs);
  munit_log_vector(MUNIT_LOG_DEBUG, quantiles);
  munit_assert_int(quantiles->size, ==, 5);

  double expected[5] = {
    1,
    3.25,
    5.5,
    7.75,
    10,
  };

  for (size_t i = 0; i < 5; i++) {
    munit_assert_double_equal(expected[i], gsl_vector_get(quantiles, i), 3);
  }

  /* Random */
  double rnorm_data[10] = {
    -1.7792761,
    -0.9436401,
    -0.8845596,
    -0.4213213,
    -0.1831428,
    -0.1497455,
    0.1402677,
    0.4509039,
    0.7415657,
    0.8864738,
  };

  v = gsl_vector_view_array((double *)rnorm_data, 10);
  quantiles = qdm_vector_quantile(&v.vector, probs);

  munit_log(MUNIT_LOG_DEBUG, "random");
  munit_log_vector(MUNIT_LOG_DEBUG, &v.vector);
  munit_log_vector(MUNIT_LOG_DEBUG, probs);
  munit_log_vector(MUNIT_LOG_DEBUG, quantiles);
  munit_assert_int(quantiles->size, ==, 5);

  double rnorm_expected[5] = {
    -1.7792761,
    -0.7687500,
    -0.1664441,
    0.3732449,
    0.8864738,
  };

  for (size_t i = 0; i < 5; i++) {
    munit_assert_double_equal(rnorm_expected[i], gsl_vector_get(quantiles, i), 3);
  }

  return MUNIT_OK;
}

static
MunitResult
test_qdm_vector_sum(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  gsl_vector_view v;
  double sum = 0.0;

  /* Basic */
  double basic_data[3] = {
    1,
    2,
    3,
  };

  v = gsl_vector_view_array((double *)basic_data, 3);
  sum = qdm_vector_sum(&v.vector);
  munit_assert_double(6, ==, sum);

  /* Interleaved alternating big sign */
  double iabs_data[4] = {
    1,
    1e100,
    1,
    -1e100,
  };

  v = gsl_vector_view_array((double *)iabs_data, 4);
  sum = qdm_vector_sum(&v.vector);
  munit_assert_double(2, ==, sum);

  /* Long sequence */
  gsl_vector *ls0_data = qdm_vector_seq(100, 1000, 1);
  sum = qdm_vector_sum(ls0_data);
  munit_assert_double(495550, ==, sum);
  gsl_vector_free(ls0_data);

  gsl_vector *ls1_data = qdm_vector_seq(10, 100, 0.1);
  sum = qdm_vector_sum(ls1_data);
  munit_assert_double_equal(49555, sum, 10);
  gsl_vector_free(ls1_data);

  gsl_vector *ls2_data = qdm_vector_seq(1, 10, 0.01);
  sum = qdm_vector_sum(ls2_data);
  munit_assert_double_equal(4955.5, sum, 10);
  gsl_vector_free(ls2_data);

  gsl_vector *ls3_data = qdm_vector_seq(0.000000001, 0.00000001, 0.00000000001);
  sum = qdm_vector_sum(ls3_data);
  munit_assert_double_equal(4.9555e-06, sum, 10);
  gsl_vector_free(ls3_data);

  return MUNIT_OK;
}

static
MunitResult
test_qdm_matrix_select_upper_triangle(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  double grid_data[] = {
      1,2,3,
      4,5,6,
      7,8,9,
  };

  gsl_matrix_view grid = gsl_matrix_view_array(grid_data, 3, 3);

  double expected_data[] = {
      1,2,3,
      0,5,6,
      0,0,9,
  };

  gsl_matrix_view expected = gsl_matrix_view_array(expected_data, 3, 3);

  qdm_matrix_select_upper_triangle(&grid.matrix);

  for (size_t i = 0; i < 3; i++) {
    for (size_t j = 0; j < 3; j++) {
      double e = gsl_matrix_get(&expected.matrix, i, j);
      double r = gsl_matrix_get(&grid.matrix, i, j);

      munit_logf(MUNIT_LOG_DEBUG, "(%zu, %zu)", i, j);
      munit_assert_double(e, ==, r);
    }
  }

  return MUNIT_OK;
}

static
MunitResult
test_qdm_matrix_to_csc_matrix(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  int status = 0;

  int n = 2;

  int P_nnz = 3;
  double P_x[3] = {4.0, 1.0, 2.0};
  int P_i[3] = {0, 0, 1};
  int P_p[3] = {0, 1, 3};

  double input_data[] = {
    4, 1,
    1, 2,
  };

  gsl_matrix_view input = gsl_matrix_view_array(input_data, 2, 2);
  qdm_matrix_select_upper_triangle(&input.matrix);

  munit_log(MUNIT_LOG_DEBUG, "input");
  qdm_matrix_csv_fwrite(stderr, &input.matrix);

  csc *result = NULL;
  status = qdm_matrix_to_csc_matrix(&result, &input.matrix);
  munit_assert_int(status, ==, 0);

  munit_assert_int(P_nnz, ==, result->nzmax);
  munit_assert_int(n, ==, result->n);

  for (size_t i = 0; i < (size_t)(result->n + 1); i++) {
    munit_logf(MUNIT_LOG_DEBUG, "result.p[%zu] = %i", i, result->p[i]);
    munit_assert_int(result->p[i], ==, P_p[i]);
  }

  for (size_t i = 0; i < (size_t)result->nzmax; i++) {
    munit_logf(MUNIT_LOG_DEBUG, "result.i[%zu] = %i", i, result->i[i]);
    munit_assert_int(result->i[i], ==, P_i[i]);
  }

  for (size_t i = 0; i < (size_t)result->nzmax; i++) {
    munit_logf(MUNIT_LOG_DEBUG, "result.x[%zu] = %.17g", i, result->x[i]);
    munit_assert_double(result->x[i], ==, P_x[i]);
  }

  return MUNIT_OK;
}

static
MunitResult
test_qdm_vector_hd5_write(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  int status = 0;

  double v_data[] = {
    1, 2, 3, 4, 5, 6, 7, 8, 9,
  };

  gsl_vector_view v = gsl_vector_view_array(v_data, 9);

  int tf_fd = 0;
  char tf_name[] = "/tmp/qdm-test-hd5-vector-XXXXXX";
  tf_fd = mkstemp(tf_name);
  close(tf_fd);

  hid_t tf_file = qdm_data_create_file(tf_name);
  munit_assert_int(tf_file, >=, 0);
  unlink(tf_name);

  hid_t tf_group = qdm_data_create_group(tf_file, "data");
  munit_assert_int(tf_group, >=, 0);

  status = qdm_vector_hd5_write(tf_group, "v", &v.vector);
  munit_assert_int(status, ==, 0);

  status = H5Gclose(tf_group);
  munit_assert_int(status, ==, 0);

  status = H5Fclose(tf_file);
  munit_assert_int(status, ==, 0);

  return MUNIT_OK;
}

static
MunitResult
test_qdm_matrix_hd5_write(
    MUNIT_UNUSED const MunitParameter params[],
    MUNIT_UNUSED void* fixture
)
{
  int status = 0;

  double m_data[] = {
    1, 2, 3,
    4, 5, 6,
    7, 8, 9,
  };

  gsl_matrix_view m = gsl_matrix_view_array(m_data, 3, 3);

  int tf_fd = 0;
  char tf_name[] = "/tmp/qdm-test-hd5-matrix-XXXXXX";
  tf_fd = mkstemp(tf_name);
  close(tf_fd);

  hid_t tf_file = qdm_data_create_file(tf_name);
  munit_assert_int(tf_file, >=, 0);
  unlink(tf_name);

  hid_t tf_group = qdm_data_create_group(tf_file, "data");
  munit_assert_int(tf_group, >=, 0);

  status = qdm_matrix_hd5_write(tf_group, "m", &m.matrix);
  munit_assert_int(status, ==, 0);

  status = H5Gclose(tf_group);
  munit_assert_int(status, ==, 0);

  status = H5Fclose(tf_file);
  munit_assert_int(status, ==, 0);

  return MUNIT_OK;
}

static char *test_param_qdm_vector_seq_min[] = {
  "1",
  "10",
  "0.1",
  NULL,
};

static char *test_param_qdm_vector_seq_max[] = {
  "10",
  "20",
  "1.1",
  NULL,
};

static char *test_param_qdm_vector_seq_delta[] = {
  "1",
  "0.1",
  "2",
  NULL,
};

static MunitParameterEnum test_params_qdm_vector_seq[] = {
  { "qdm_vector_seq_min"   , test_param_qdm_vector_seq_min   }  ,
  { "qdm_vector_seq_max"   , test_param_qdm_vector_seq_max   }  ,
  { "qdm_vector_seq_delta" , test_param_qdm_vector_seq_delta }  ,
  { NULL                   , NULL                            }  ,
};

MunitTest tests_gsl[] = {
  {
    "/qdm_vector_seq"          , // name
    test_qdm_vector_seq        , // test
    NULL                       , // setup
    NULL                       , // tear_down
    MUNIT_TEST_OPTION_NONE     , // options
    test_params_qdm_vector_seq , // parameters
  },
  {
    "/qdm_vector_set_seq",   // name
    test_qdm_vector_set_seq, // test
    NULL,                    // setup
    NULL,                    // tear_down
    MUNIT_TEST_OPTION_NONE,  // options
    NULL,                    // parameters
  },
  {
    "/qdm_matrix_det_tmm"   , // name
    test_qdm_matrix_det_tmm , // test
    NULL                    , // setup
    NULL                    , // tear_down
    MUNIT_TEST_OPTION_NONE  , // options
    NULL                    , // parameters
  },
  {
    "/qdm_vector_quantile"   , // name
    test_qdm_vector_quantile , // test
    NULL                     , // setup
    NULL                     , // tear_down
    MUNIT_TEST_OPTION_NONE   , // options
    NULL                     , // parameters
  },
  {
    "/qdm_vector_sum"      , // name
    test_qdm_vector_sum    , // test
    NULL                   , // setup
    NULL                   , // tear_down
    MUNIT_TEST_OPTION_NONE , // options
    NULL                   , // parameters
  },
  {
    "/qdm_matrix_select_upper_triangle"   , // name
    test_qdm_matrix_select_upper_triangle , // test
    NULL                                  , // setup
    NULL                                  , // tear_down
    MUNIT_TEST_OPTION_NONE                , // options
    NULL                                  , // parameters
  },
  {
    "/qdm_matrix_to_csc_matrix"   , // name
    test_qdm_matrix_to_csc_matrix , // test
    NULL                          , // setup
    NULL                          , // tear_down
    MUNIT_TEST_OPTION_NONE        , // options
    NULL                          , // parameters
  },
  {
    "/qdm_vector_hd5_write"   , // name
    test_qdm_vector_hd5_write , // test
    NULL                      , // setup
    NULL                      , // tear_down
    MUNIT_TEST_OPTION_NONE    , // options
    NULL                      , // parameters
  },
  {
    "/qdm_matrix_hd5_write"   , // name
    test_qdm_matrix_hd5_write , // test
    NULL                      , // setup
    NULL                      , // tear_down
    MUNIT_TEST_OPTION_NONE    , // options
    NULL                      , // parameters
  },
  { NULL, NULL, NULL, NULL, MUNIT_TEST_OPTION_NONE, NULL },
};

static const MunitSuite test_suite_gsl = {
  "/gsl"                  , // name
  tests_gsl               , // tests
  NULL                    , // suites
  1                       , // iterations
  MUNIT_SUITE_OPTION_NONE , // options
};


/* linalg/hesstri.c
 *
 * Copyright (C) 2006, 2007 Patrick Alken
 *
 * 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.
 */

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

#include <config.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_blas.h>

#include "givens.c"

/*
 * This module contains routines related to the Hessenberg-Triangular
 * reduction of two general real matrices
 *
 * See Golub & Van Loan, "Matrix Computations", 3rd ed, sec 7.7.4
 */

/*
gsl_linalg_hesstri_decomp()
  Perform a reduction to generalized upper Hessenberg form.
Given A and B, this function overwrites A with an upper Hessenberg
matrix H = U^T A V and B with an upper triangular matrix R = U^T B V
with U and V orthogonal.

See Golub & Van Loan, "Matrix Computations" (3rd ed) algorithm 7.7.1

Inputs: A    - real square matrix
        B    - real square matrix
        U    - (output) if non-null, U is stored here on output
        V    - (output) if non-null, V is stored here on output
        work - workspace (length n)

Return: success or error
*/

int
gsl_linalg_hesstri_decomp(gsl_matrix * A, gsl_matrix * B, gsl_matrix * U,
                          gsl_matrix * V, gsl_vector * work)
{
  const size_t N = A->size1;

  if ((N != A->size2) || (N != B->size1) || (N != B->size2))
    {
      GSL_ERROR ("Hessenberg-triangular reduction requires square matrices",
                 GSL_ENOTSQR);
    }
  else if (N != work->size)
    {
      GSL_ERROR ("length of workspace must match matrix dimension",
                 GSL_EBADLEN);
    }
  else
    {
      double cs, sn;          /* rotation parameters */
      size_t i, j;            /* looping */
      gsl_vector_view xv, yv; /* temporary views */

      /* B -> Q^T B = R (upper triangular) */
      gsl_linalg_QR_decomp(B, work);

      /* A -> Q^T A */
      gsl_linalg_QR_QTmat(B, work, A);

      /* initialize U and V if desired */

      if (U)
        {
          gsl_linalg_QR_unpack(B, work, U, B);
        }
      else
        {
          /* zero out lower triangle of B */
          for (j = 0; j < N - 1; ++j)
            {
              for (i = j + 1; i < N; ++i)
                gsl_matrix_set(B, i, j, 0.0);
            }
        }

      if (V)
        gsl_matrix_set_identity(V);

      if (N < 3)
        return GSL_SUCCESS; /* nothing more to do */

      /* reduce A and B */
      for (j = 0; j < N - 2; ++j)
        {
          for (i = N - 1; i >= (j + 2); --i)
            {
              /* step 1: rotate rows i - 1, i to kill A(i,j) */

              /*
               * compute G = [ CS SN ] so that G^t [ A(i-1,j) ] = [ * ]
               *             [-SN CS ]             [ A(i, j)  ]   [ 0 ]
               */
              create_givens(gsl_matrix_get(A, i - 1, j),
                            gsl_matrix_get(A, i, j),
                            &cs,
                            &sn);
              /* invert so drot() works correctly (G -> G^t) */
              sn = -sn;

              /* compute G^t A(i-1:i, j:n) */
              xv = gsl_matrix_subrow(A, i - 1, j, N - j);
              yv = gsl_matrix_subrow(A, i, j, N - j);
              gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);

              /* compute G^t B(i-1:i, i-1:n) */
              xv = gsl_matrix_subrow(B, i - 1, i - 1, N - i + 1);
              yv = gsl_matrix_subrow(B, i, i - 1, N - i + 1);
              gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);

              if (U)
                {
                  /* accumulate U: U -> U G */
                  xv = gsl_matrix_column(U, i - 1);
                  yv = gsl_matrix_column(U, i);
                  gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);
                }

              /* step 2: rotate columns i, i - 1 to kill B(i, i - 1) */

              create_givens(-gsl_matrix_get(B, i, i),
                            gsl_matrix_get(B, i, i - 1),
                            &cs,
                            &sn);
              /* invert so drot() works correctly (G -> G^t) */
              sn = -sn;

              /* compute B(1:i, i-1:i) G */
              xv = gsl_matrix_subcolumn(B, i - 1, 0, i + 1);
              yv = gsl_matrix_subcolumn(B, i, 0, i + 1);
              gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);

              /* apply to A(1:n, i-1:i) */
              xv = gsl_matrix_column(A, i - 1);
              yv = gsl_matrix_column(A, i);
              gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);

              if (V)
                {
                  /* accumulate V: V -> V G */
                  xv = gsl_matrix_column(V, i - 1);
                  yv = gsl_matrix_column(V, i);
                  gsl_blas_drot(&xv.vector, &yv.vector, cs, sn);
                }
            }
        }

      return GSL_SUCCESS;
    }
} /* gsl_linalg_hesstri_decomp() */


/********************************\
* Matrix Multiply Test Benchmark *
*                                *
* by                             *
*   Elliott Forney               *
*   3.15.2010                    *
\********************************/

/*
 *  Libraries
 */

#include <stdio.h>
#include <stdlib.h>
#include <stdio.h>
#include <stdbool.h>
#include <unistd.h>
#include <getopt.h>

#include <cblas.h>

#include "matrix.h"
#include "benchmark.h"
#include "errcheck.h"

/*
 *  Macros
 */

// print command line usage
#define print_usage() fprintf(stdout, "Usage: %s [-m a_rows] [-n a_cols] [-p b_cols] [-s]\n", arg[0])

// acceptable maximum relative error tolerance
#define TOLERANCE 0.01

#define DEBUG 0

/*
 *  Global variables
 */

// flag for simple, one line output
bool simple_out = false;

/*
 *  Function prototypes
 */

// parse command line arguments
void parse_args(int narg, char **arg,
                unsigned *m, unsigned *n,
                unsigned *p);

/*
 *  Function bodies
 */

// setup network
int main(int narg, char **arg)
{
  // default matrix dimensions
  unsigned m = 6400;
  unsigned n = 0;
  unsigned p = 0;

  // parse command line arguments
  parse_args(narg, arg, &m, &n, &p);

  // if n or p == 0 then set to m
  if (n == 0)
    n = m;
  if (p == 0)
    p = m;

  if (DEBUG > 0)
    printf("m: %d\nn: %d\np: %d\n", m, n, p);

  // create matrix to hold result
  matrix result;
  matrix_init(&result, m, p);
  matrix_load_runif(result, 500, 600);

  // load test matrix a
  matrix a;
  matrix_init(&a, m, p);
//  matrix_load_testa(a, n);

  // load test matrix b
  matrix b;
  matrix_init(&b, m, n);
//  matrix_load_testb(b);
  matrix_load_runif(b, 0, 1);

  // load test matrix c
  matrix c;
  matrix_init(&c, n, p);
  matrix_load_testc(c);
  matrix_load_runif(c, 0, 1);

  // figure a with BLAS
  cblas_sgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
              b.r, c.c, b.c, 1.0f,
              b.cpu_data, b.cstride, c.cpu_data, c.cstride,
              0.0f, a.cpu_data, a.cstride);

  // run warm up
  matrix_mult(result, b, c);

  // wait for all kernels to finish
  matrix_wait();

  // create a new benchmark timer
  benchmark ben;
  benchmark_init(&ben);

  // start timer
  benchmark_start_timer(&ben);

  // run multiplication
  matrix_mult(result, b, c);

  // wait for all kernels to finish
  matrix_wait();

  if (DEBUG > 5)
  {
    printf("a:\n");
    matrix_print_padded(a);
    printf("b:\n");
    matrix_print_padded(b);
    printf("c:\n");
    matrix_print_padded(c);
    printf("result:\n");
    matrix_print_padded(result);
  }

  // stop timer
  benchmark_stop_timer(&ben);

  // figure giga floating point operatins per second
  benchmark_add_flop(&ben, matmult_nflop(m,n,p));
  benchmark_add_byte(&ben, (m*n+n*p+m*p)*sizeof(float));
  double gbytes = benchmark_check_gbytes(ben);
  double gflops = benchmark_check_gflops(ben);
  double time   = benchmark_check_timer(ben);

  //
  float rmse = matrix_rmse(a, result);
  bool passed = true;
  if (rmse > TOLERANCE)
    passed = false;

  // if simple output requested
  if (simple_out)
    // simply print time, gflops and error
    printf("%f %f\n", time*1e3f, gflops);

  // if full output requested
  else
  {
    if (passed)
      printf("Test Passed!\n=======\n");
    else
      printf("Test Failed!\n=======\n");

    // print time and gflops
    printf("Time: %f  GByteS: %f  GFlopS: %f  RMSE: %f\n",
           time, gbytes, gflops, rmse);
  }

  // clean up
  matrix_dest(&a);
  matrix_dest(&b);
  matrix_dest(&c);
  matrix_dest(&result);
  benchmark_dest(&ben);

  // Come back soon now ya'hear!
  return 0;
}

// parse command line arguments
void parse_args(int narg, char **arg,
                unsigned *m, unsigned *n,
                unsigned *p)
{
  int opt; // getopt output

  // for each argument
  while ((opt = getopt(narg, arg, "sm:n:p:")) != -1)
  {
    if (opt == 's')
      simple_out = true;

    else if (opt == 'm')
      *m = (unsigned)atoi(arg[optind-1]);

    else if (opt == 'n')
      *n = (unsigned)atoi(arg[optind-1]);

    else if (opt == 'p')
      *p = (unsigned)atoi(arg[optind-1]);

    // print usage and quit on unknown option
    else
    {
      print_usage();
      exit(1);
    }
  }

  // assume last non dash arg is m
  if (optind < narg)
    *m = (unsigned)atoi(arg[optind]);
}


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

#include <gsl/gsl_linalg.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix_double.h>
#include <gsl/gsl_vector_double.h>
#include <gsl/gsl_blas.h>

int main() {
	int ret;
	int i, j;
	gsl_vector* tau;
	gsl_matrix *A;
	gsl_matrix *Q, *R, *RTR;
	gsl_matrix_view Rtop;
	int M = 4;
	int N = 3;

	/*
	  gsl_matrix A;
	  double data[9];
	  memset(&A, 0, sizeof(gsl_matrix));
	  A.size1 = 3;
	  A.size2 = 3;
	  A.tda = 3;
	  A.data = data;
	  gsl_matrix_set(&A, 0, 0, 34.0);
	  gsl_matrix_set(&A, 0, 1, 4.0);
	  gsl_matrix_set(&A, 0, 2, 14.0);
	  gsl_matrix_set(&A, 1, 0, 1.0);
	  gsl_matrix_set(&A, 1, 1, 8.0);
	  gsl_matrix_set(&A, 1, 2, 3.0);
	  gsl_matrix_set(&A, 2, 0, 7.0);
	  gsl_matrix_set(&A, 2, 1, 1.0);
	  gsl_matrix_set(&A, 2, 2, 8.0);
	*/

	A = gsl_matrix_alloc(M, N);

	for (i=0; i<M; i++)
		for (j=0; j<N; j++)
			gsl_matrix_set(A, i, j, (double)rand()/(double)RAND_MAX);

	for (i=0; i<A->size1; i++) {
		printf((i==0) ? "A = (" : "    (");
		for (j=0; j<A->size2; j++) {
			printf(" %12.5g ", gsl_matrix_get(A, i, j));
		}
		printf(")\n");
	}
	printf("\n");

	tau = gsl_vector_alloc(N);

	ret = gsl_linalg_QR_decomp(A, tau);

	Q = gsl_matrix_alloc(M, M);
	R = gsl_matrix_alloc(M, N);

	ret = gsl_linalg_QR_unpack(A, tau, Q, R);

	for (i=0; i<Q->size1; i++) {
		printf((i==0) ? "Q = (" : "    (");
		for (j=0; j<Q->size2; j++) {
			printf(" %12.5g ", gsl_matrix_get(Q, i, j));
		}
		printf(")\n");
	}
	printf("\n");

	for (i=0; i<R->size1; i++) {
		printf((i==0) ? "R = (" : "    (");
		for (j=0; j<R->size2; j++) {
			printf(" %12.5g ", gsl_matrix_get(R, i, j));
		}
		printf(")\n");
	}
	printf("\n");

	Rtop = gsl_matrix_submatrix(R, 0, 0, N, N);
	RTR = gsl_matrix_alloc(N, N);
	gsl_matrix_memcpy(RTR, &(Rtop.matrix));
	ret = gsl_blas_dtrmm(CblasLeft, CblasUpper, CblasTrans, CblasNonUnit,
						 1.0, RTR, RTR);
	//(Rtop.matrix), &(Rtop.matrix));

	for (i=0; i<RTR->size1; i++) {
		printf((i==0) ? "RTR = (" : "      (");
		for (j=0; j<RTR->size2; j++) {
			printf(" %12.5g ", gsl_matrix_get(RTR, i, j));
		}
		printf(")\n");
	}
	printf("\n");

	gsl_matrix_free(RTR);

	gsl_matrix_free(Q);
	gsl_matrix_free(R);
	gsl_vector_free(tau);

	gsl_matrix_free(A);

	return 0;
}


// Copyright (c) 2021 Stig Rune Sellevag
//
// This file is distributed under the MIT License. See the accompanying file
// LICENSE.txt or http://www.opensource.org/licenses/mit-license.php for terms
// and conditions.

#ifndef SCILIB_LINALG_EIGENVALUE_H
#define SCILIB_LINALG_EIGENVALUE_H

#ifdef USE_MKL
#include <mkl.h>
#else
#include <lapacke.h>
#endif

#include <scilib/mdarray.h>
#include <scilib/linalg_impl/lapack_types.h>
#include <exception>
#include <cassert>
#include <complex>
#include <type_traits>

namespace Sci {
namespace Linalg {

// Compute eigenvalues and eigenvectors of a real symmetric matrix.
template <class Layout>
inline void eigs(Sci::Matrix_view<double, Layout> a,
                 Sci::Vector_view<double, Layout> w,
                 double abstol = -1.0 /* use default value */)
{
    static_assert(a.is_contiguous());
    static_assert(w.is_contiguous());

    assert(a.extent(0) == a.extent(1));
    assert(w.extent(0) == a.extent(0));

    const BLAS_INT n = static_cast<BLAS_INT>(a.extent(0));
    const BLAS_INT nselect = n;
    const BLAS_INT lda = n;
    const BLAS_INT ldz = nselect;

    BLAS_INT il = 1;
    BLAS_INT iu = n;
    BLAS_INT m;
    BLAS_INT info;

    double vl = 0.0;
    double vu = 0.0;

    Sci::Vector<BLAS_INT, Layout> isuppz(2 * n);
    Sci::Matrix<double, Layout> z(ldz, n);

    auto matrix_layout = LAPACK_ROW_MAJOR;
    if constexpr (std::is_same_v<Layout, stdex::layout_left>) {
        matrix_layout = LAPACK_COL_MAJOR;
    }

    info = LAPACKE_dsyevr(matrix_layout, 'V', 'A', 'U', n, a.data(), lda, vl,
                          vu, il, iu, abstol, &m, w.data(), z.data(), ldz,
                          isuppz.data());
    if (info != 0) {
        throw std::runtime_error("dsyevr failed");
    }
    Sci::copy(z.view(), a);
}

template <class Layout, class Allocator>
inline void eigs(Sci::Matrix<double, Layout, Allocator>& a,
                 Sci::Vector<double, Layout, Allocator>& w,
                 double abstol = -1.0 /* use default value */)
{
    eigs(a.view(), w.view(), abstol);
}

// Compute eigenvalues and eigenvectors of a real non-symmetric matrix.
template <class Layout>
void eig(Sci::Matrix_view<double, Layout> a,
         Sci::Matrix_view<std::complex<double>, Layout> evec,
         Sci::Vector_view<std::complex<double>, Layout> eval)
{
    using namespace Sci;

    static_assert(a.is_contiguous());
    static_assert(evec.is_contiguous());
    static_assert(eval.is_contiguous());

    assert(a.extent(0) == a.extent(1));
    assert(a.extent(0) == eval.extent(0));
    assert(a.extent(0) == evec.extent(0));
    assert(a.extent(1) == evec.extent(1));

    const BLAS_INT n = static_cast<BLAS_INT>(a.extent(1));

    Sci::Vector<double, Layout> wr(n);
    Sci::Vector<double, Layout> wi(n);
    Sci::Matrix<double, Layout> vr(n, n);
    Sci::Matrix<double, Layout> vl(n, n);

    auto matrix_layout = LAPACK_ROW_MAJOR;
    if constexpr (std::is_same_v<Layout, stdex::layout_left>) {
        matrix_layout = LAPACK_COL_MAJOR;
    }
    BLAS_INT info =
        LAPACKE_dgeev(matrix_layout, 'N', 'V', n, a.data(), n, wr.data(),
                      wi.data(), vl.data(), n, vr.data(), n);
    if (info != 0) {
        throw std::runtime_error("dgeev failed");
    }
    for (BLAS_INT i = 0; i < n; ++i) {
        std::complex<double> wii(wr(i), wi(i));
        eval(i) = wii;
        BLAS_INT j = 0;
        while (j < n) {
            if (wi(j) == 0.0) {
                evec(i, j) = std::complex<double>{vr(i, j), 0.0};
                ++j;
            }
            else {
                evec(i, j) = std::complex<double>{vr(i, j), vr(i, j + 1)};
                evec(i, j + 1) = std::complex<double>{vr(i, j), -vr(i, j + 1)};
                j += 2;
            }
        }
    }
}

template <class Layout,
          class Allocator_a,
          class Allocator_evec,
          class Allocator_eval>
void eig(Sci::Matrix<double, Layout, Allocator_a>& a,
         Sci::Matrix<std::complex<double>, Layout, Allocator_evec>& evec,
         Sci::Vector<std::complex<double>, Layout, Allocator_eval>& eval)
{
    eig(a.view(), evec.view(), eval.view());
}

} // namespace Linalg
} // namespace Sci

#endif // SCILIB_LINALG_EIGENVALUE_H


/* randist/dirichlet.c
 *
 * 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.
 */

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

/* The Dirichlet probability distribution of order K-1 is

     p(\theta_1,...,\theta_K) d\theta_1 ... d\theta_K =
        (1/Z) \prod_i=1,K \theta_i^{alpha_i - 1} \delta(1 -\sum_i=1,K \theta_i)

   The normalization factor Z can be expressed in terms of gamma functions:

      Z = {\prod_i=1,K \Gamma(\alpha_i)} / {\Gamma( \sum_i=1,K \alpha_i)}

   The K constants, \alpha_1,...,\alpha_K, must be positive. The K parameters,
   \theta_1,...,\theta_K are nonnegative and sum to 1.

   The random variates are generated by sampling K values from gamma
   distributions with parameters a=\alpha_i, b=1, and renormalizing.
   See A.M. Law, W.D. Kelton, Simulation Modeling and Analysis (1991).

   Gavin E. Crooks <gec@compbio.berkeley.edu> (2002)
*/

void
gsl_ran_dirichlet (const gsl_rng * r, const size_t K,
                   const double alpha[], double theta[])
{
  size_t i;
  double norm = 0.0;

  for (i = 0; i < K; i++)
    {
      theta[i] = gsl_ran_gamma (r, alpha[i], 1.0);
    }

  for (i = 0; i < K; i++)
    {
      norm += theta[i];
    }

  for (i = 0; i < K; i++)
    {
      theta[i] /= norm;
    }
}

double
gsl_ran_dirichlet_pdf (const size_t K,
                       const double alpha[], const double theta[])
{
  return exp (gsl_ran_dirichlet_lnpdf (K, alpha, theta));
}

double
gsl_ran_dirichlet_lnpdf (const size_t K,
                         const double alpha[], const double theta[])
{
  /*We calculate the log of the pdf to minimize the possibility of overflow */
  size_t i;
  double log_p = 0.0;
  double sum_alpha = 0.0;

  for (i = 0; i < K; i++)
    {
      log_p += (alpha[i] - 1.0) * log (theta[i]);
    }

  for (i = 0; i < K; i++)
    {
      sum_alpha += alpha[i];
    }

  log_p += gsl_sf_lngamma (sum_alpha);

  for (i = 0; i < K; i++)
    {
      log_p -= gsl_sf_lngamma (alpha[i]);
    }

  return log_p;
}


/*
** gsl routines for float data type
**
** G.Lohmann, July 2004
*/
#include <viaio/Vlib.h>

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

#include <gsl/gsl_cblas.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_sort_vector.h>
#include "gsl_utils.h"

/*
** y = Ax
*/
gsl_vector_float *fmat_x_vector(gsl_matrix_float *A, gsl_vector_float *x, gsl_vector_float *y)
{
  if (y == NULL) {
    y = gsl_vector_float_alloc (A->size1);
  }

  gsl_blas_sgemv(CblasNoTrans, 1.0, A, x, 0.0, y);

  return y;
}

/*
**    C = A x B^T
*/
gsl_matrix_float *fmat_x_matT(gsl_matrix_float *A,gsl_matrix_float *B,gsl_matrix_float *C)
{
  if (C == NULL) {
    C = gsl_matrix_float_alloc( A->size1, B->size1 );
  }

  gsl_blas_sgemm( CblasNoTrans, CblasTrans, 1.0, A, B, 0.0, C );

  return C;
}

/*
**    C = A^T x B
*/
gsl_matrix_float *fmatT_x_mat(gsl_matrix_float *A,gsl_matrix_float *B,gsl_matrix_float *C)
{
  if (C == NULL) {
    C = gsl_matrix_float_alloc( A->size2, B->size2 );
  }

  gsl_blas_sgemm( CblasTrans, CblasNoTrans, 1.0, A, B, 0.0, C );

  return C;
}

/*
**    C = A x B
*/
gsl_matrix_float *fmat_x_mat(gsl_matrix_float *A,gsl_matrix_float *B,gsl_matrix_float *C)
{
  if (C == NULL) {
    C = gsl_matrix_float_alloc( A->size1, B->size2 );
  }

  gsl_blas_sgemm( CblasNoTrans, CblasNoTrans, 1.0, A, B, 0.0, C );

  return C;
}

/*
**  y = Ax,  A double, x float
*/
gsl_vector_float *dmat_x_fvector(gsl_matrix *A, gsl_vector_float *x, gsl_vector_float *y)
{
  int i,j,nrows,ncols;
  float *ptr2,*ptr3,sum;
  double *ptr1;

  nrows = A->size1;
  ncols = A->size2;

  if (y == NULL) {
     y = gsl_vector_float_alloc (nrows);
  }

  if (x->size != ncols || y->size != nrows) {
    fprintf(stderr," fmat_x_vect: incongruent dimensions\n");
    exit(0);
  }

  ptr1 = A->data;
  ptr3 = y->data;

  for (i=0; i<nrows; i++) {
    sum = 0;
    ptr2 = x->data;
    for (j=0; j<ncols; j++) {
      sum += (*ptr1++) * (*ptr2++);
    }
    *ptr3++ = sum;
  }
  return y;
}

/*
**  z = x^T y
*/
float fskalarproduct(gsl_vector_float *x,gsl_vector_float *y)
{
  int i,n;
  float *ptr1,*ptr2,sum;

  n = x->size;
  if (y->size != n) {
    fprintf(stderr," fskalarproduct: incongruent vector sizes: %d %ld",n,y->size);
    exit(0);
  }

  ptr1 = x->data;
  ptr2 = y->data;
  sum = 0;
  for (i=0; i<n; i++) {
    sum += (*ptr1) * (*ptr2);
    ptr1++;
    ptr2++;
  }
  return sum;
}

/*
**    printout
*/
void fmatprint(FILE *fp,gsl_matrix_float *A,const char *format)
{
  int i,j;
  for (i=0; i<A->size1; i++) {
    for (j=0; j<A->size2; j++) {
      fprintf(fp,format,fmget(A,i,j));
    }
    fprintf(fp,"\n");
  }
  fprintf(fp,"\n");

}

/*
**    B = A^T
*/
gsl_matrix_float *ftranspose(gsl_matrix_float *A,gsl_matrix_float *B)
{
  int i,j,n,m;

  n = A->size1;
  m = A->size2;

  if (B == NULL) {
    B = gsl_matrix_float_alloc(m,n);
  }
  else if (B->size1 != m || B->size2 != n) {
    gsl_matrix_float_free(B);
    B = gsl_matrix_float_alloc(m,n);
  }

  for (i=0; i<n; i++) {
    for (j=0; j<m; j++) {
      fmset(B,j,i,fmget(A,i,j));
    }
  }
  return B;
}

/*
**    B = A^-1 = A^+
*/
gsl_matrix_float *fmat_PseudoInv(gsl_matrix_float *A,gsl_matrix_float *B)
{
  int i,j,k,l,n,m;
  double u,x;
  double *dbl_pp;
  float *flt_pp;

  m = A->size1;
  n = A->size2;

  if (B == NULL) {
    B = gsl_matrix_float_alloc (n,m);
  }
  else if (B->size1 != n || B->size2 != m) {
    gsl_matrix_float_free(B);
    B = gsl_matrix_float_alloc (n, m);
  }

  gsl_matrix *U = gsl_matrix_alloc (m, n);
  gsl_matrix *V = gsl_matrix_alloc (n, n);
  gsl_matrix *X = gsl_matrix_alloc (n, n);
  gsl_vector *w = gsl_vector_alloc (n);
  gsl_vector *work = gsl_vector_alloc (n);

  /* singular value decomposition */
  flt_pp = A->data;
  dbl_pp = U->data;
  for (i=0; i<A->size1 * A->size2; i++)
    *dbl_pp++ = *flt_pp++;

  /* gsl_linalg_SV_decomp_jacobi(U,V,w); */
  gsl_linalg_SV_decomp_mod (U,X,V,w,work);

  /* check if singular */
  k=0;
  for (j=0; j<n; j++) {
    if (fabs(w->data[j]) > 1.0e-6) k++;
  }
  if (k < 2) VError(" Design matrix is singular");

  /* exception from Gaby */
  int j0 = 0;
  double xmin, xmax, tiny=10.0e-6;
  xmax = gsl_vector_get(w,0);
  xmin = tiny;
  for (j=n-1; j >= 0; j--) {
    u = gsl_vector_get(w,j);
    if (u > 0 && u/xmax > tiny) {
      j0 = j;
      goto skip;
    }
  }
 skip: ;
  if (j0 < n-1) {
    fprintf(stderr," Warning: Matrix almost singular\n");
    xmin = gsl_vector_get(w,j0) - tiny;
    if (xmin < 0) xmin = 0;
  }

  /* Fill the result matrix */
  gsl_matrix_float_set_zero(B);
  for (k=0; k<n; k++) {
    for (l=0; l<m; l++) {
      for (j=0; j<n; j++) {
	u = gsl_vector_get(w,j);
        if (fabs(u) > xmin) {
          x = gsl_matrix_float_get(B,k,l);
	  x += gsl_matrix_get(V,k,j)*gsl_matrix_get(U,l,j)/u;
          gsl_matrix_float_set(B,k,l,x);
        }
      }
    }
  }
  gsl_matrix_free(U);
  gsl_matrix_free(V);
  gsl_matrix_free(X);
  gsl_vector_free(w);
  gsl_vector_free(work);
  return B;
}

/*
** returns the trace of a matrix M
*/
float trace(gsl_matrix_float *M)
{
  gsl_vector_float_view diag = gsl_matrix_float_diagonal(M);
  float sum = 0;
  int i = 0;
  for(i = 0; i<diag.vector.size; i++) {
    sum += gsl_vector_float_get(&diag.vector,i);
  }
  return sum;
}

/*
**  rank(A)
*/
int rank(gsl_matrix_float* mat)
{
  int m = mat->size1;
  int n = mat->size2;
  int i;

  /* Create matrix buffer from source matrix. This prevents the overwriting of
   * matrix mat by gsl_linalg_SV_decomp().*/
  gsl_matrix* U = gsl_matrix_alloc(m,n);
  double* dpU =  U->data;
  float* fpMat = mat->data;
  for(i=0;i<mat->size1* mat->size2;i++) {
    *dpU++ = *fpMat++;
  }

  /* create additional matrix buffers */
  gsl_matrix *V;
  gsl_matrix *X;
  gsl_vector *S;
  gsl_vector *work;
  S = gsl_vector_alloc(n);
  V = gsl_matrix_alloc(n,n);
  X = gsl_matrix_alloc (n, n);
  work = gsl_vector_alloc (n);

  /* SVD */
  /* gsl_linalg_SV_decomp_jacobi(U,V,S); */
  gsl_linalg_SV_decomp_mod (U,X,V,S,work);

  int rank = 0;
  /* counting the nonzero singular values with a tolerance of EPSILON*/
  for(i=0;i<S->size;i++){
    if(S->data[i] > EPSILON) {
      rank++;
    }
  }

  gsl_matrix_free(U);
  gsl_matrix_free(V);
  gsl_matrix_free(X);
  gsl_vector_free(S);
  gsl_vector_free(work);

  return rank;
}

/*
**  fsum
*/
gsl_vector_float *fsum(gsl_matrix_float *matrix, int dim,gsl_vector_float *v)
{

  int row,col;
  float sum=0;

  /* build sum over all columns */
  if (dim == 1) {

    if (v == NULL) {
      v = gsl_vector_float_alloc(matrix->size2);
    }
    if(v->size != matrix->size2) {
      fprintf(stderr, "Warning in fsum: vector size doesn't match related matrix dimension. Resizing ..");
      gsl_vector_float_free(v);
      v = gsl_vector_float_alloc(matrix->size2);
    }

    for (col=0;col<matrix->size2;col++){
      sum=0;
      for(row=0;row<matrix->size1;row++) {
	sum+=matrix->data[col+row*matrix->size2];
      }
      v->data[col] = sum;
    }
  }

  /* build sum over all rows */
  else {

    if (v == NULL) {
      v = gsl_vector_float_alloc(matrix->size1);
    }

    if (v->size != matrix->size1) {
      fprintf(stderr, "Warning in fsum: vector size doesn't match related matrix dimension. Resizing ..");
      gsl_vector_float_free(v);
      v = gsl_vector_float_alloc(matrix->size1);
    }

    for (row = 0;row<matrix->size1;row++) {
      sum = 0;
      for(col=0;col<matrix->size2;col++) {
	sum += matrix->data[col+row*matrix->size2];
      }
      v->data[row] = sum;
    }
  }
  return v;
}

/*
**  funique
*/
gsl_vector_float *funique(gsl_vector_float* V)
{

  /* working copy */
  gsl_vector_float* v = gsl_vector_float_alloc(V->size);
  /* pointer to result */
  gsl_vector_float* res;
  /* holds value of last saved element */
  float max=0;
  /* counter */
  int i;

  gsl_vector_float_memcpy(v,V);

  /* sort elements from V. */
  gsl_sort_vector_float(v);

  /* count number of different elements */
  int nelements = 0;

  /* first run: count different values */
  float* p = v->data;
  for(i=0;i<v->size;i++) {
    /* the first element in the list is special */
    if(i==0) {
      max = *p;
      nelements++;
    }
    else {
      if(*p > max) {
	max = *p;
	nelements++;
      }
    }
    p++;
  }

  /* second run: allocate mem & copy every value exactly once. */
  res = gsl_vector_float_alloc(nelements);
  p = v->data;
  float *s = res->data;
  for(i=0;i<v->size;i++) {
    if(i==0) {
      max = *p;
      *s++ = *p;
    }
    else {
      if(*p > max) {
	max = *p;
	*s++ = *p;
      }
    }
    p++;
  }

  gsl_vector_float_free(v);

  return res;
}

/*
**  subcols
*/
gsl_matrix_float *fmat_subcols(gsl_matrix_float* mat,gsl_vector_float* cols)
{

  /* some tests */

  if((cols->size < 0) || (cols->size > mat->size2)) {
    fprintf(stderr,"column vector: invalid dimensions");
    exit(-1);
  }

  float min, max;
  gsl_vector_float_minmax(cols, &min, &max);

  if((min < 0) || (max > mat->size2)) {
    fprintf(stderr,"column vector values exceed matrix dimensions!");
    exit(-1);
  }

  /* TODO reduce column vector to unique values with funique. We will omit
   * this due to performance reasons. */

  /* the return value */
  gsl_matrix_float* ret = gsl_matrix_float_alloc(mat->size1, cols->size);
  /* the copy buffer */
  gsl_vector_float* buff = gsl_vector_float_alloc(mat->size1);
  /* counter */
  int i;

  /* copy columns from matrix to return buffer */
  for (i = 0; i < cols->size; ++i) {
    gsl_matrix_float_get_col(buff, mat, (int)cols->data[i]);
    gsl_matrix_float_set_col(ret, i, buff);
  }

  gsl_vector_float_free(buff);

  return ret;
}

/*
**  toeplitz
*/
gsl_matrix_float *fmat_toeplitz(gsl_vector_float* v, gsl_matrix_float* A)
{
  int i,j;

  if(A == NULL)
    A = gsl_matrix_float_alloc(v->size, v->size);
  else {
    if((A->size1 != v->size)  || (A->size2 != v->size)) {
      fprintf(stderr, "Warning fmat_toeplitz: incongruent matrix dimensions. Trying to\
                    correct it.");
      gsl_matrix_float_free(A);
      A = gsl_matrix_float_alloc(v->size, v->size);
    }
  }

  for(i=0;i<A->size1;i++){
    for(j=0;j<A->size2;j++) {
      gsl_matrix_float_set(A,i,j,gsl_vector_float_get(v, fabs(i-j)));
    }
  }

  return A;
}

/*
**  A^-1
*/
gsl_matrix_float *fInv(gsl_matrix_float *M, gsl_matrix_float *result)
{
  int s; /*permutation signum for LU-Decomposition*/
  int i;

  int m = M->size1;
  int n = M->size2;

  if(m != n) {
    fprintf(stderr, "dInv: not a square matrix\n");
    exit(0);
  }

  if(result == NULL) {
    result = gsl_matrix_float_alloc(m,m);
  }
  if((result->size1 != m) || (result->size2 != n)) {
    fprintf(stderr,"dInv: incongruent matrix dimensions.\n");
    exit(0);
  }

  gsl_matrix *ludecomp = gsl_matrix_alloc(m,m);
  gsl_permutation *perm = gsl_permutation_alloc(m);
  gsl_matrix *res = gsl_matrix_alloc(m,m);

  /* convert from float to double */
  double *d_ptr = ludecomp->data;
  float *f_ptr = M->data;
  for(i=0;i<M->size1*M->size2;i++) {
    *d_ptr = (double)*f_ptr;
    d_ptr++;f_ptr++;
  }

  /* LU decomposition */
  gsl_linalg_LU_decomp(ludecomp,perm,&s);

  /* inverting matrix */
  gsl_linalg_LU_invert(ludecomp,perm,res);

  /* convert from double to float */
  d_ptr = res->data;
  f_ptr = result->data;
  for(i=0;i<res->size1*res->size2;i++) {
    *f_ptr = (float)*d_ptr;
    d_ptr++;f_ptr++;
  }

  gsl_matrix_free(ludecomp);
  gsl_matrix_free(res);
  gsl_permutation_free(perm);
  return result;
}


/* Copyright (c) Kyrylo Polezhaiev and contributors. All rights reserved.
   Released under the MIT license. See LICENSE file in the project root for full license information. */

#include "leopenblas.h"
#include <assert.h>
#include <le/le.h>
#include <le/tensors/letensor-imp.h>
#include <cblas.h>

LeTensor *
le_openblas_matrix_new_product(const LeTensor *a, bool transpose_a, const LeTensor *b, bool transpose_b)
{
    /// @todo: Take stride into account
    assert(a->element_type == LE_TYPE_FLOAT32);
    assert(b->element_type == LE_TYPE_FLOAT32);
    assert(a->shape->num_dimensions == 2);
    assert(b->shape->num_dimensions == 2);
    assert(le_tensor_contiguous(a));
    assert(le_tensor_contiguous(b));

    unsigned size_a = transpose_a ? a->shape->sizes[0] : a->shape->sizes[1];
    unsigned size_b = transpose_b ? b->shape->sizes[1] : b->shape->sizes[0];
    assert(size_a == size_b);

    unsigned c_height = transpose_a ? a->shape->sizes[1] : a->shape->sizes[0];
    unsigned c_width = transpose_b ? b->shape->sizes[0] : b->shape->sizes[1];

    LeTensor *c = le_matrix_new_uninitialized(LE_TYPE_FLOAT32, c_height, c_width);

    cblas_sgemm(CblasRowMajor,
                transpose_a ? CblasTrans : CblasNoTrans,
                transpose_b ? CblasTrans : CblasNoTrans,
                c_height, c_width, size_a,
                1.0f,
                a->data, a->shape->sizes[1],
                b->data, b->shape->sizes[1],
                0.0f,
                c->data, c->shape->sizes[1]);

    return c;
}

float
le_openblas_dot_product(const LeTensor *a, const LeTensor *b)
{
    assert(a->element_type == LE_TYPE_FLOAT32);
    assert(b->element_type == LE_TYPE_FLOAT32);
    assert(a->shape->num_dimensions == 2);
    assert(b->shape->num_dimensions == 2);
    /** @todo: Test results against transposed a multiplied by b */
    assert(a->shape->sizes[0] == b->shape->sizes[0]);
    assert(a->shape->sizes[1] == 1);
    assert(b->shape->sizes[1] == 1);

    return cblas_sdot(a->shape->sizes[0], a->data, a->stride, b->data, b->stride);
}


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

#include <gsl/gsl_errno.h>
#include <gsl/gsl_odeiv2.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_roots.h>

#include "ccl.h"
#include "ccl_params.h"

/* --------- ROUTINE: h_over_h0 ---------
INPUT: scale factor, cosmology
TASK: Compute E(a)=H(a)/H0
*/
static double h_over_h0(double a, ccl_cosmology * cosmo, int *status)
{
  // Check if massive neutrinos are present - if not, we don't need to
  // compute their contribution
  double Om_mass_nu;
  if ((cosmo->params.N_nu_mass)>1e-12) {
    Om_mass_nu = ccl_Omeganuh2(
      a, cosmo->params.N_nu_mass, cosmo->params.mnu, cosmo->params.T_CMB,
      cosmo->data.accelerator, status) / (cosmo->params.h) / (cosmo->params.h);
    ccl_check_status(cosmo, status);
  }
  else {
    Om_mass_nu = 0;
  }

  /* Calculate h^2 using the formula (eqn 2 in the CCL paper):
    E(a)^2 = Omega_m a^-3 +
             Omega_l a^(-3*(1+w0+wa)) exp(3*wa*(a-1)) +
             Omega_k a^-2 +
             (Omega_g + Omega_n_rel) a^-4 +
             Om_mass_nu
  */
  return sqrt(
    (cosmo->params.Omega_m +
     cosmo->params.Omega_l *
       pow(a,-3*(cosmo->params.w0+cosmo->params.wa)) *
       exp(3*cosmo->params.wa*(a-1)) +
     cosmo->params.Omega_k * a +
     (cosmo->params.Omega_g + cosmo->params.Omega_n_rel) / a +
     Om_mass_nu * a*a*a) / (a*a*a));
}

/* --------- ROUTINE: ccl_omega_x ---------
INPUT: cosmology object, scale factor, species label
TASK: Compute the density relative to critical, Omega(a) for a given species.
Possible values for "label":
ccl_species_crit_label <- critical (physical)
ccl_species_m_label <- matter
ccl_species_l_label <- DE
ccl_species_g_label <- radiation
ccl_species_k_label <- curvature
ccl_species_ur_label <- massless neutrinos
ccl_species_nu_label <- massive neutrinos
*/
double ccl_omega_x(ccl_cosmology * cosmo, double a, ccl_species_x_label label, int *status)
{
  // If massive neutrinos are present, compute the phase-space integral and
  // get OmegaNuh2. If not, set OmegaNuh2 to zero.
  double OmNuh2;
  if ((cosmo->params.N_nu_mass) > 0.0001) {
    // Call the massive neutrino density function just once at this redshift.
    OmNuh2 = ccl_Omeganuh2(a, cosmo->params.N_nu_mass, cosmo->params.mnu,
		       cosmo->params.T_CMB, cosmo->data.accelerator, status);
    ccl_check_status(cosmo, status);
  }
  else {
    OmNuh2 = 0.;
  }

  double hnorm = h_over_h0(a, cosmo, status);

  switch(label) {
    case ccl_species_crit_label :
      return 1.;
    case ccl_species_m_label :
      return cosmo->params.Omega_m / (a*a*a) / hnorm / hnorm;
    case ccl_species_l_label :
      return
        cosmo->params.Omega_l *
        pow(a,-3 * (1 + cosmo->params.w0 + cosmo->params.wa)) *
        exp(3 * cosmo->params.wa * (a-1)) / hnorm / hnorm;
    case ccl_species_g_label :
      return cosmo->params.Omega_g / (a*a*a*a) / hnorm / hnorm;
    case ccl_species_k_label :
      return cosmo->params.Omega_k / (a*a) / hnorm / hnorm;
    case ccl_species_ur_label :
      return cosmo->params.Omega_n_rel / (a*a*a*a) / hnorm / hnorm;
    case ccl_species_nu_label :
      return OmNuh2 / (cosmo->params.h) / (cosmo->params.h) / hnorm / hnorm;
    default:
      *status = CCL_ERROR_PARAMETERS;
      ccl_cosmology_set_status_message(
        cosmo, "ccl_background.c: ccl_omega_x(): Species %d not supported\n", label);
      return NAN;
  }
}

/* --------- ROUTINE: ccl_rho_x ---------
INPUT: cosmology object, scale factor, species label
TASK: Compute rho_x(a), with x defined by species label.
Possible values for "label":
ccl_species_crit_label <- critical (physical)
ccl_species_m_label <- matter (physical)
ccl_species_l_label <- DE (physical)
ccl_species_g_label <- radiation (physical)
ccl_species_k_label <- curvature (physical)
ccl_species_ur_label <- massless neutrinos (physical)
ccl_species_nu_label <- massive neutrinos (physical)
*/
double ccl_rho_x(ccl_cosmology * cosmo, double a, ccl_species_x_label label, int is_comoving, int *status)
{
  double comfac;
  if (is_comoving) {
     comfac = a*a*a;
  } else {
      comfac = 1.0;
  }
  double hnorm = h_over_h0(a, cosmo, status);
  double rhocrit =
    RHO_CRITICAL *
    (cosmo->params.h) *
    (cosmo->params.h) * hnorm * hnorm * comfac;

  return rhocrit * ccl_omega_x(cosmo, a, label, status);
}

// Structure to hold parameters of chi_integrand
typedef struct {
  ccl_cosmology *cosmo;
  int * status;
} chipar;

/* --------- ROUTINE: chi_integrand ---------
INPUT: scale factor
TASK: compute the integrand of the comoving distance
*/
static double chi_integrand(double a, void * params_void)
{
  ccl_cosmology * cosmo = ((chipar *)params_void)->cosmo;
  int *status = ((chipar *)params_void)->status;

  return CLIGHT_HMPC/(a*a*h_over_h0(a, cosmo, status));
}

/* --------- ROUTINE: growth_ode_system ---------
INPUT: scale factor
TASK: Define the ODE system to be solved in order to compute the growth (of the density)
*/
static int growth_ode_system(double a,const double y[],double dydt[],void *params)
{
  int status = 0;
  ccl_cosmology * cosmo = params;

  double hnorm=h_over_h0(a,cosmo, &status);
  double om=ccl_omega_x(cosmo, a, ccl_species_m_label, &status);

  dydt[0]=y[1]/(a*a*a*hnorm);
  dydt[1]=1.5*hnorm*a*om*y[0];

  return status;
}

/* --------- ROUTINE: df_integrand ---------
INPUT: scale factor, spline object
TASK: Compute integrand from modified growth function
*/
static double df_integrand(double a,void * spline_void)
{
  if(a<=0)
    return 0;
  else {
    gsl_spline *df_a_spline=(gsl_spline *)spline_void;

    return gsl_spline_eval(df_a_spline,a,NULL)/a;
  }
}

/* --------- ROUTINE: growth_factor_and_growth_rate ---------
INPUT: scale factor, cosmology
TASK: compute the growth (D(z)) and the growth rate, logarithmic derivative (f?)
*/

static int  growth_factor_and_growth_rate(double a,double *gf,double *fg,ccl_cosmology *cosmo, int *stat)
{
  if(a<EPS_SCALEFAC_GROWTH) {
    *gf=a;
    *fg=1;
    return 0;
  }
  else {
    int gslstatus;
    double y[2];
    double ainit=EPS_SCALEFAC_GROWTH;
    gsl_odeiv2_system sys={growth_ode_system,NULL,2,cosmo};
    gsl_odeiv2_driver *d=
      gsl_odeiv2_driver_alloc_y_new(&sys,gsl_odeiv2_step_rkck,0.1*EPS_SCALEFAC_GROWTH,0,ccl_gsl->ODE_GROWTH_EPSREL);

    y[0]=EPS_SCALEFAC_GROWTH;
    y[1]=EPS_SCALEFAC_GROWTH*EPS_SCALEFAC_GROWTH*EPS_SCALEFAC_GROWTH*
      h_over_h0(EPS_SCALEFAC_GROWTH,cosmo, stat);

    gslstatus=gsl_odeiv2_driver_apply(d,&ainit,a,y);
    gsl_odeiv2_driver_free(d);

    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: growth_factor_and_growth_rate():");
      return NAN;
    }

    *gf=y[0];
    *fg=y[1]/(a*a*h_over_h0(a,cosmo, stat)*y[0]);
    return 0;
  }
}

/* --------- ROUTINE: compute_chi ---------
INPUT: scale factor, cosmology
OUTPUT: chi -> radial comoving distance
TASK: compute radial comoving distance at a
*/
static void compute_chi(double a, ccl_cosmology *cosmo, double * chi, int * stat)
{
  int gslstatus;
  double result;
  chipar p;

  p.cosmo=cosmo;
  p.status=stat;

  gsl_integration_cquad_workspace * workspace = gsl_integration_cquad_workspace_alloc(ccl_gsl->N_ITERATION);
  gsl_function F;
  F.function = &chi_integrand;
  F.params = &p;
  //TODO: CQUAD is great, but slower than other methods. This could be sped up if it becomes an issue.
  gslstatus=gsl_integration_cquad(
    &F, a, 1.0, 0.0, ccl_gsl->INTEGRATION_DISTANCE_EPSREL, workspace, &result, NULL, NULL);
  *chi=result/cosmo->params.h;
  gsl_integration_cquad_workspace_free(workspace);

  if (gslstatus != GSL_SUCCESS) {
    ccl_raise_gsl_warning(gslstatus, "ccl_background.c: compute_chi():");
    *stat = CCL_ERROR_COMPUTECHI;
  }
}

//Root finding for a(chi)
typedef struct {
  double chi;
  ccl_cosmology *cosmo;
  int * status;
} Fpar;

static double fzero(double a,void *params)
{
  double chi,chia,a_use=a;

  chi=((Fpar *)params)->chi;
  compute_chi(a_use,((Fpar *)params)->cosmo,&chia, ((Fpar *)params)->status);

  return chi-chia;
}

static double dfzero(double a,void *params)
{
  ccl_cosmology *cosmo=((Fpar *)params)->cosmo;
  int *stat = ((Fpar *)params)->status;

  chipar p;
  p.cosmo=cosmo;
  p.status=stat;

  return chi_integrand(a,&p)/cosmo->params.h;
}

static void fdfzero(double a,void *params,double *f,double *df)
{
  *f=fzero(a,params);
  *df=dfzero(a,params);
}

/* --------- ROUTINE: a_of_chi ---------
INPUT: comoving distance chi, cosmology, stat, a_old, gsl_root_fdfsolver
OUTPUT: scale factor
TASK: compute the scale factor that corresponds to a given comoving distance chi
Note: This routine uses a root solver to find an a such that compute_chi(a) = chi.
The root solver uses the derivative of compute_chi (which is chi_integrand) and
the value itself.
*/
static void a_of_chi(double chi, ccl_cosmology *cosmo, int* stat, double *a_old, gsl_root_fdfsolver *s)
{
  if(chi==0) {
    *a_old=1;
  }
  else {
    Fpar p;
    gsl_function_fdf FDF;
    double a_previous,a_current=*a_old;

    p.cosmo=cosmo;
    p.chi=chi;
    p.status=stat;
    FDF.f=&fzero;
    FDF.df=&dfzero;
    FDF.fdf=&fdfzero;
    FDF.params=&p;
    gsl_root_fdfsolver_set(s,&FDF,a_current);

    int iter=0, gslstatus;
    do {
      iter++;
      gslstatus=gsl_root_fdfsolver_iterate(s);
      if(gslstatus!=GSL_SUCCESS) ccl_raise_gsl_warning(gslstatus, "ccl_background.c: a_of_chi():");
      a_previous=a_current;
      a_current=gsl_root_fdfsolver_root(s);
      gslstatus=gsl_root_test_delta(a_current, a_previous, 0, ccl_gsl->ROOT_EPSREL);
    } while(gslstatus==GSL_CONTINUE && iter <= ccl_gsl->ROOT_N_ITERATION);

    *a_old=a_current;

    // Allows us to pass a status to h_over_h0 for the neutrino integral calculation.
    if(gslstatus==GSL_SUCCESS) {
      *stat = *(p.status);
    }
    else {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: a_of_chi():");
      *stat = CCL_ERROR_COMPUTECHI;
    }
  }
}

/* ----- ROUTINE: ccl_cosmology_compute_distances ------
INPUT: cosmology
TASK: if not already there, make a table of comoving distances and of E(a)
*/

void ccl_cosmology_compute_distances(ccl_cosmology * cosmo, int *status)
{

  //Do nothing if everything is computed already
  if(cosmo->computed_distances)
    return;

  if(ccl_splines->A_SPLINE_MAX>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    return;
  }

  // Create logarithmically and then linearly-spaced values of the scale factor
  int na = ccl_splines->A_SPLINE_NA+ccl_splines->A_SPLINE_NLOG-1;
  double * a = ccl_linlog_spacing(ccl_splines->A_SPLINE_MINLOG, ccl_splines->A_SPLINE_MIN,
				  ccl_splines->A_SPLINE_MAX, ccl_splines->A_SPLINE_NLOG,
				  ccl_splines->A_SPLINE_NA);
  // Allocate arrays for all three of E(a), chi(a), and a(chi)
  double *E_a = malloc(sizeof(double)*na);
  double *chi_a = malloc(sizeof(double)*na);
  // Allocate E(a) and chi(a) splines
  gsl_spline * E = gsl_spline_alloc(A_SPLINE_TYPE, na);
  gsl_spline * chi = gsl_spline_alloc(A_SPLINE_TYPE, na);
  // a(chi) spline allocated below

  //Check for too little memory
  if (a==NULL || E_a==NULL || chi_a==NULL){
    *status=CCL_ERROR_MEMORY;

    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
  }

  //Check for messed up scale factor conditions
  if (!*status){
    if ((fabs(a[0]-ccl_splines->A_SPLINE_MINLOG)>1e-5) ||
	(fabs(a[na-1]-ccl_splines->A_SPLINE_MAX)>1e-5) ||
	(a[na-1]>1.0)) {
      *status = CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating first logarithmic and then linear spacing in a\n");
    }
  }

  // Fill in E(a) - note, this step cannot change the status variable
  if (!*status)
    for (int i=0; i<na; i++)
      E_a[i] = h_over_h0(a[i], cosmo, status);

  // Create a E(a) spline
  if (!*status){
    if (gsl_spline_init(E, a, E_a, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  E(a) spline\n");
    }
  }

  // Compute chi(a)
  if (!*status){
    for (int i=0; i<na; i++)
      compute_chi(a[i], cosmo, &chi_a[i], status);
    if (*status){
      *status = CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): chi(a) integration error \n");
    }
  }

  // Initialize chi(a) spline
  if (!*status){
    if (gsl_spline_init(chi, a, chi_a, na)){//in Mpc
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  chi(a) spline\n");
    }
  }

  if (*status){//If there was an error, free the GSL splines and return
    gsl_spline_free(E); //Note: you are allowed to call gsl_free() on NULL
    gsl_spline_free(chi);
  }

  // Set up the boundaries for the a(chi) spline
  double dchi, chi0, chif, a0, af;
  if(!*status){
    dchi=5.;
    chi0=chi_a[na-1];
    chif=chi_a[0];
    a0=a[na-1];
    af=a[0];
  }

  //TODO: The interval in chi (5. Mpc) should be made a macro
  free(a); //Free these, in preparation for making a(chi) splines
  free(E_a);
  free(chi_a);
  //Note: you are allowed to call free() on NULL

  ////////////////////////////////////////////////////////////////////////////////////////////////////
  //Below here na (length of some arrays) changes, so this function has to be split at this point.
  ////////////////////////////////////////////////////////////////////////////////////////////////////

  na = (int)((chif-chi0)/dchi);
  dchi  = (chif-chi0)/na; // <=5, since na is an integer
  //Allocate new arrays for a and chi(a)
  chi_a = ccl_linear_spacing(chi0, chif, na);
  a     = malloc(sizeof(double)*na);
  //Allocate space for GSL root finders
  const gsl_root_fdfsolver_type *T=gsl_root_fdfsolver_newton;
  gsl_root_fdfsolver *s=gsl_root_fdfsolver_alloc(T);
  gsl_spline *achi;

  //Check for too little memory
  if (!*status){
    achi=gsl_spline_alloc(A_SPLINE_TYPE, na);
    if (a==NULL || chi_a==NULL){
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
    }else if(fabs(chi_a[0]-chi0)>1e-5 || fabs(chi_a[na-1]-chif)>1e-5) { //Check for messed up chi conditions
      *status = CCL_ERROR_LINSPACE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating linear spacing in chi\n");
    }
  }

  // Calculate a(chi)
  if (!*status){
    a[0]=a0; a[na-1]=af;
    for(int i=1;i<na-1;i++) {
      // we are using the previous value as a guess here to help the root finder
      // as long as we use small steps in a this should be fine
      a_of_chi(chi_a[i],cosmo, status, &a0, s);
      a[i]=a0;
    }
    if(*status) {
      *status = CCL_ERROR_ROOT;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): a(chi) root-finding error \n");
    }
  }

  // Initialize the a(chi) spline
  if (!*status){
    if(gsl_spline_init(achi, chi_a, a, na)){
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): Error creating  a(chi) spline\n");
    }
  }

  free(a);
  free(chi_a); //Note: you are allowed to call free() on NULL
  gsl_root_fdfsolver_free(s);
  if (*status){//If there was an error, free the GSL splines and return
    gsl_spline_free(E); //Note: you are allowed to call gsl_free() on NULL
    gsl_spline_free(chi);
    gsl_spline_free(achi);
    return;
  }

  //If there were no errors, attach the splines to the cosmo struct and end the function.
  if(cosmo->data.accelerator==NULL)
    cosmo->data.accelerator=gsl_interp_accel_alloc();
  cosmo->data.E             = E;
  cosmo->data.chi           = chi;
  cosmo->data.achi          = achi;
  cosmo->computed_distances = true;
}

/* ----- ROUTINE: ccl_cosmology_compute_growth ------
INPUT: cosmology
TASK: if not already there, make a table of growth function and growth rate
      normalize growth to input parameter growth0
*/

void ccl_cosmology_compute_growth(ccl_cosmology * cosmo, int * status)
{

  // This is not valid for massive neutrinos; if we have massive neutrinos, exit.
  if (cosmo->params.N_nu_mass>0){
	  *status = CCL_ERROR_NOT_IMPLEMENTED;
	  ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Support for the growth rate in cosmologies with massive neutrinos is not yet implemented.\n");
	  return;
  }

  if(cosmo->computed_growth)
    return;

  // Create logarithmically and then linearly-spaced values of the scale factor
  int  chistatus = 0, na = ccl_splines->A_SPLINE_NA+ccl_splines->A_SPLINE_NLOG-1;
  double * a = ccl_linlog_spacing(ccl_splines->A_SPLINE_MINLOG, ccl_splines->A_SPLINE_MIN, ccl_splines->A_SPLINE_MAX, ccl_splines->A_SPLINE_NLOG, ccl_splines->A_SPLINE_NA);
  if (a==NULL ||
      (fabs(a[0]-ccl_splines->A_SPLINE_MINLOG)>1e-5) ||
      (fabs(a[na-1]-ccl_splines->A_SPLINE_MAX)>1e-5) ||
      (a[na-1]>1.0)
      ) {
    free(a);
    *status = CCL_ERROR_LINSPACE;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating logarithmically and then linear spacing in a\n");
    return;
  }

  gsl_integration_cquad_workspace * workspace=NULL;
  gsl_function F;
  gsl_spline *df_a_spline=NULL;
  if(cosmo->params.has_mgrowth) {
    double *df_arr=malloc(na*sizeof(double));
    if(df_arr==NULL) {
      free(a);
      *status=CCL_ERROR_MEMORY;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
      return;
    }
    //Generate spline for Delta f(z) that we will then interpolate into an array of a
    gsl_spline *df_z_spline=gsl_spline_alloc(A_SPLINE_TYPE,cosmo->params.nz_mgrowth);
    chistatus=gsl_spline_init(df_z_spline,cosmo->params.z_mgrowth,cosmo->params.df_mgrowth,
			      cosmo->params.nz_mgrowth);

    if(chistatus) {
      free(a);
      free(df_arr);
      gsl_spline_free(df_z_spline);
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating Delta f(z) spline\n");
      return;
    }
    for (int i=0; i<na; i++) {
      if(a[i]>0) {
        double z=1./a[i]-1.;

        if(z<=cosmo->params.z_mgrowth[0])
          df_arr[i]=cosmo->params.df_mgrowth[0];
        else if(z>cosmo->params.z_mgrowth[cosmo->params.nz_mgrowth-1])
          df_arr[i]=cosmo->params.df_mgrowth[cosmo->params.nz_mgrowth-1];
        else
	       chistatus |= gsl_spline_eval_e(df_z_spline,z,NULL,&df_arr[i]);
      } else {
	     df_arr[i]=0;
      }
    }
    if(chistatus) {
      free(a);
      free(df_arr);
      gsl_spline_free(df_z_spline);
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error evaluating Delta f(z) spline\n");
      return;
    }
    gsl_spline_free(df_z_spline);

    //Generate Delta(f) spline
    df_a_spline=gsl_spline_alloc(A_SPLINE_TYPE,na);
    chistatus=gsl_spline_init(df_a_spline,a,df_arr,na);
    free(df_arr);
    if (chistatus) {
      free(a);
      gsl_spline_free(df_a_spline);
      *status = CCL_ERROR_SPLINE;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating Delta f(a) spline\n");
      return;
    }

    workspace=gsl_integration_cquad_workspace_alloc(ccl_gsl->N_ITERATION);
    F.function=&df_integrand;
    F.params=df_a_spline;
  }

  // allocate space for y, which will be all three
  // of E(a), chi(a), D(a) and f(a) in turn.
  int  status_mg=0, gslstatus;
  double growth0,fgrowth0;
  double *y = malloc(sizeof(double)*na);
  if(y==NULL) {
    free(a);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
    return;
  }
  double *y2 = malloc(sizeof(double)*na);
  if(y2==NULL) {
    free(a);
    free(y);
    *status=CCL_ERROR_MEMORY;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_distances(): ran out of memory\n");
    return;
  }

  chistatus|=growth_factor_and_growth_rate(1.,&growth0,&fgrowth0,cosmo, status);
  for(int i=0; i<na; i++) {
    chistatus|=growth_factor_and_growth_rate(a[i],&(y[i]),&(y2[i]),cosmo, status);
    if(cosmo->params.has_mgrowth) {
      if(a[i]>0) {
	double df,integ;
	//Add modification to f
	gslstatus = gsl_spline_eval_e(df_a_spline,a[i],NULL,&df);
  if(gslstatus != GSL_SUCCESS) {
    ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_cosmology_compute_growth():");
    status_mg |= gslstatus;
  }
	y2[i]+=df;
	//Multiply D by exp(-int(df))
	gslstatus = gsl_integration_cquad(&F,a[i],1.0,0.0,ccl_gsl->INTEGRATION_DISTANCE_EPSREL,workspace,&integ,NULL,NULL);
	if(gslstatus != GSL_SUCCESS) {
    ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_cosmology_compute_growth():");
    status_mg |= gslstatus;
  }
  y[i]*=exp(-integ);
      }
    }
    y[i]/=growth0;
  }
  if(chistatus || status_mg || *status) {
    free(a);
    free(y);
    free(y2);
    if(df_a_spline!=NULL)
      gsl_spline_free(df_a_spline);
    if(workspace!=NULL)
      gsl_integration_cquad_workspace_free(workspace);
    if (chistatus) {
      *status = CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): integral for linear growth factor didn't converge\n");
    }
    if(status_mg) {
      *status = CCL_ERROR_INTEG;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): integral for MG growth factor didn't converge\n");
    }
    return;
  }

  if(cosmo->params.has_mgrowth) {
    gsl_spline_free(df_a_spline);
    gsl_integration_cquad_workspace_free(workspace);
  }

  gsl_spline * growth = gsl_spline_alloc(A_SPLINE_TYPE, na);
  chistatus = gsl_spline_init(growth, a, y, na);
  if(chistatus) {
    free(a);
    free(y);
    free(y2);
    gsl_spline_free(growth);
    *status = CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating D(a) spline\n");
    return;
  }

  gsl_spline * fgrowth = gsl_spline_alloc(A_SPLINE_TYPE, na);
  chistatus = gsl_spline_init(fgrowth, a, y2, na);
  if(chistatus) {
    free(a);
    free(y);
    free(y2);
    gsl_spline_free(growth);
    gsl_spline_free(fgrowth);
    *status = CCL_ERROR_SPLINE;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_cosmology_compute_growth(): Error creating f(a) spline\n");
    return;
  }

  // Initialize the accelerator which speeds the splines and
  // assign all the splines we've just made to the structure.
  if(cosmo->data.accelerator==NULL)
    cosmo->data.accelerator=gsl_interp_accel_alloc();
  cosmo->data.growth = growth;
  cosmo->data.fgrowth = fgrowth;
  cosmo->data.growth0 = growth0;
  cosmo->computed_growth = true;

  free(a);
  free(y);
  free(y2);

  return;
}

//Expansion rate normalized to 1 today

double ccl_h_over_h0(ccl_cosmology * cosmo, double a, int* status)
{

  if(!cosmo->computed_distances) {
    ccl_cosmology_compute_distances(cosmo,status);
    ccl_check_status(cosmo, status);
  }

  double h_over_h0;
  int gslstatus = gsl_spline_eval_e(cosmo->data.E, a, cosmo->data.accelerator,&h_over_h0);
  if(gslstatus != GSL_SUCCESS) {
    ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_h_over_h0():");
    *status = gslstatus;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_h_over_h0(): Scale factor outside interpolation range.\n");
    return NAN;
  }

  return h_over_h0;
}

void ccl_h_over_h0s(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_h_over_h0(cosmo, a[i], &_status);
    *status |= _status;
  }
}

// Distance-like function examples, all in Mpc
double ccl_comoving_radial_distance(ccl_cosmology * cosmo, double a, int * status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    return 0.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  }
  else {
    if(!cosmo->computed_distances) {
      ccl_cosmology_compute_distances(cosmo, status);
      ccl_check_status(cosmo,status);
    }

    double crd;
    int gslstatus = gsl_spline_eval_e(cosmo->data.chi, a, cosmo->data.accelerator, &crd);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_comoving_radial_distance():");
      *status = gslstatus;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_comoving_radial_distance(): Scale factor outside interpolation range.\n");
      return NAN;
    }
    return crd;
  }
}

void ccl_comoving_radial_distances(ccl_cosmology * cosmo, int na, double a[], double output[], int* status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_comoving_radial_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_sinn(ccl_cosmology *cosmo, double chi, int *status)
{
  //////
  //         { sin(x)  , if k==1
  // sinn(x)={  x      , if k==0
  //         { sinh(x) , if k==-1
  switch(cosmo->params.k_sign) {
  case -1:
    return sinh(cosmo->params.sqrtk * chi) / cosmo->params.sqrtk;
  case 1:
    return sin(cosmo->params.sqrtk*chi) / cosmo->params.sqrtk;
  case 0:
    return chi;
  default:
    *status = CCL_ERROR_PARAMETERS;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_sinn: ill-defined cosmo->params.k_sign = %d",
	    cosmo->params.k_sign);
    return NAN;
  }
}

double ccl_comoving_angular_distance(ccl_cosmology * cosmo, double a, int* status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    return 0.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  }
  else {
    if (!cosmo->computed_distances) {
      ccl_cosmology_compute_distances(cosmo, status);
      ccl_check_status(cosmo, status);
    }

    double chi;
    int gslstatus = gsl_spline_eval_e(cosmo->data.chi, a,
                                      cosmo->data.accelerator,&chi);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_comoving_angular_distance():");
      *status |= gslstatus;
      ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_comoving_angular_distance(): Scale factor outside interpolation range.\n");
      return NAN;
    }
    return ccl_sinn(cosmo,chi,status);
  }
}

void ccl_comoving_angular_distances(ccl_cosmology * cosmo, int na, double a[],
                                    double output[], int* status)
{
  int _status;

  for (int i=0; i < na; i++) {
    _status = 0;
    output[i] = ccl_comoving_angular_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_luminosity_distance(ccl_cosmology * cosmo, double a, int* status)
{
  return ccl_comoving_angular_distance(cosmo, a, status) / a;
}

void ccl_luminosity_distances(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_luminosity_distance(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_distance_modulus(ccl_cosmology * cosmo, double a, int* status)
{
  if((a > (1.0 - 1.e-8)) && (a<=1.0)) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: distance_modulus undefined for a=1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  } else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  } else {
    if (!cosmo->computed_distances) {
      ccl_cosmology_compute_distances(cosmo, status);
      ccl_check_status(cosmo, status);
    }
    /* distance modulus = 5 * log10(d) - 5
       Since d in CCL is in Mpc, you get
         5*log10(10^6) - 5 = 30 - 5 = 25
      for the constant.
    */
    return 5 * log10(ccl_luminosity_distance(cosmo, a, status)) + 25;
  }
}

void ccl_distance_moduli(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_distance_modulus(cosmo, a[i], &_status);
    *status |= _status;
  }
}

//Scale factor for a given distance
double ccl_scale_factor_of_chi(ccl_cosmology * cosmo, double chi, int * status)
{
  if((chi < 1.e-8) && (chi>=0.)) {
    return 1.;
  }
  else if(chi<0.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: distance cannot be smaller than 0.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  }
  else {
    if (!cosmo->computed_distances) {
      ccl_cosmology_compute_distances(cosmo,status);
      ccl_check_status(cosmo,status);
    }
    double a;
    int gslstatus = gsl_spline_eval_e(cosmo->data.achi, chi,cosmo->data.accelerator_achi, &a);
    if(gslstatus != GSL_SUCCESS) {
      ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_scale_factor_of_chi():");
      *status |= gslstatus;
    }
    return a;
  }
}

//
void ccl_scale_factor_of_chis(ccl_cosmology * cosmo, int nchi, double chi[], double output[], int * status)
{
  int _status;

  for (int i=0; i<nchi; i++) {
    _status = 0;
    output[i] = ccl_scale_factor_of_chi(cosmo, chi[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_factor(ccl_cosmology * cosmo, double a, int * status)
{
  if(a==1.){
    return 1.;
  }
  else if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  }
  else {
    if (!cosmo->computed_growth) {
      ccl_cosmology_compute_growth(cosmo, status);
      ccl_check_status(cosmo, status);
    }
    if (*status!= CCL_ERROR_NOT_IMPLEMENTED) {
      double D;
      int gslstatus = gsl_spline_eval_e(cosmo->data.growth, a, cosmo->data.accelerator,&D);
      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_growth_factor():");
        *status |= gslstatus;
        ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_growth_factor(): Scale factor outside interpolation range.\n");
        return NAN;
      }
      return D;
    }
    else {
      return NAN;
    }
  }
}

void ccl_growth_factors(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_factor(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_factor_unnorm(ccl_cosmology * cosmo, double a, int * status)
{

  if (!cosmo->computed_growth) {
    ccl_cosmology_compute_growth(cosmo, status);
    ccl_check_status(cosmo, status);
  }

  if (*status != CCL_ERROR_NOT_IMPLEMENTED) {
      return cosmo->data.growth0 * ccl_growth_factor(cosmo, a, status);
  } else {
    return NAN;
  }
}

void ccl_growth_factors_unnorm(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_factor_unnorm(cosmo, a[i], &_status);
    *status |= _status;
  }
}

double ccl_growth_rate(ccl_cosmology * cosmo, double a, int * status)
{
  if(a>1.) {
    *status = CCL_ERROR_COMPUTECHI;
    ccl_cosmology_set_status_message(cosmo, "ccl_background.c: scale factor cannot be larger than 1.\n");
    ccl_check_status(cosmo,status);
    return NAN;
  } else {
    if (!cosmo->computed_growth) {
      ccl_cosmology_compute_growth(cosmo, status);
      ccl_check_status(cosmo, status);
    }
    if(*status != CCL_ERROR_NOT_IMPLEMENTED) {
      double g;
      int gslstatus = gsl_spline_eval_e(cosmo->data.fgrowth, a, cosmo->data.accelerator,&g);
      if(gslstatus != GSL_SUCCESS) {
        ccl_raise_gsl_warning(gslstatus, "ccl_background.c: ccl_growth_rate():");
        *status |= gslstatus;
        ccl_cosmology_set_status_message(cosmo, "ccl_background.c: ccl_growth_rate(): Scale factor outside interpolation range.\n");
        return NAN;
      }
      return g;
    } else {
	    return NAN;
	  }
  }
}

void ccl_growth_rates(ccl_cosmology * cosmo, int na, double a[], double output[], int * status)
{
  int _status;

  for (int i=0; i<na; i++) {
    _status = 0;
    output[i] = ccl_growth_rate(cosmo, a[i], &_status);
    *status |= _status;
  }
}