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

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

#include <cblas.h>
#include "morn_tensor.h"

struct TensorReshapePara
{
    MLayer *prev;

    int channel;
    int height;
    int width;

    int res_valid;
};

void *mTensorReshapePara(MList *ini,char *name)
{
    struct TensorReshapePara *para = (struct TensorReshapePara *)mMalloc(sizeof(struct TensorReshapePara));

    char *value = mINIRead(ini,name,"prev");
    para->prev = mNetworkLayer(ini,value);
    mException((para->prev == NULL),EXIT,"invalid prev");

    para->res_valid = (strcmp("Input",mLayerType(para->prev))!=0);

    value = mINIRead(ini,name,"height");
    if(value != NULL) para->height= atoi(value);else para->height= DFLT;

    value = mINIRead(ini,name,"width");
    if(value != NULL) para->width = atoi(value);else para->width = DFLT;

    value = mINIRead(ini,name,"channel");
    if(value != NULL) para->channel = atoi(value);else para->channel = DFLT;

    return para;
}

void TensorReshapeSet(MLayer *layer)
{
    if(layer->state != DFLT) return;
    struct TensorReshapePara *para = (struct TensorReshapePara *)(layer->para);
    MTensor *in = para->prev->tns;
    MTensor *res= para->prev->res;
    MTensor *out= layer->tns;

    int size = in->height*in->width*in->channel;

    if(para->height <=0) para->height = size/(para->width *para->channel);
    if(para->width  <=0) para->width  = size/(para->height*para->channel);
    if(para->channel<=0) para->channel= size/(para->height*para->width  );
    mException((para->height<0)||(para->width<0)||(para->channel<0)||(para->height*para->width*para->channel!=size),EXIT,"invalid input shape, with shape input is %d,%d,%d",in->channel,in->height,in->width);

    mTensorRedefine(out,in->batch,para->channel,para->height,para->width,in->data);
    if(morn_network_flag==MORN_TRAIN)
    {
        if(INVALID_TENSOR(res)) mTensorRedefine(res,in->batch,in->channel,in->height,in->width,in->data);
        else                    mTensorRedefine(res,in->batch,in->channel,in->height,in->width,NULL);
    }
}

void mTensorReshapeForward(MLayer *layer)
{
    mException(INVALID_POINTER(layer),EXIT,"invalid input");
    mException(strcmp("Reshape",mLayerType(layer)),EXIT,"invalid layer type");

    TensorReshapeSet(layer);

    layer->state = MORN_FORWARD;
}

void mTensorReshapeBackward(MLayer *layer)
{
    mException(INVALID_POINTER(layer),EXIT,"invalid input");
    mException(strcmp("Reshape",mLayerType(layer)),EXIT,"invalid layer type");
    struct TensorReshapePara *para = (struct TensorReshapePara *)(layer->para);
    if(para->res_valid==0) return;

    MTensor *res= para->prev->res;
    MTensor *out= layer->res;
    int size = res->height*res->width*res->channel;
    for(int b=0;b<res->batch;b++)if(res->data[b]!=out->data[b]) memcpy(res->data[b],out->data[b],size*sizeof(float));

    para->prev->state = MORN_BACKWARD;
}


//===--- Sudoku/Solver_find.h                                           ---===//
//
// Helper functions, to find available options
//===----------------------------------------------------------------------===//
// list_where_*
// appearance_*: collecting options by appearance count in a given set.
//===----------------------------------------------------------------------===//
#pragma once

#include "Board_Section_traits.h"
#include "Location.h"
#include "Options.h"
#include "Size.h"
#include "Value.h"
#include "traits.h"

#include <gsl/gsl>

#include <array>
#include <vector>

#include <algorithm> // find, find_if
#include <iterator>
#include <type_traits> // is_base_of

#include "Board.fwd.h" // Forward declarations

#include <cassert>

namespace Sudoku
{
//===----------------------------------------------------------------------===//
template<int N, typename SectionT>
[[nodiscard]] auto
	list_where_option(SectionT, Value, ptrdiff_t rep_count = elem_size<N>);

template<int N, typename ItrT>
[[nodiscard]] auto
	list_where_option(ItrT begin, ItrT end, Value, ptrdiff_t rep_count = 0);

template<int N, typename SectionT, typename Options = Options<elem_size<N>>>
[[nodiscard]] auto
	list_where_option(const SectionT, const Options sample) noexcept(true);

template<int N, typename SectionT, typename Options = Options<elem_size<N>>>
[[nodiscard]] auto list_where_equal(SectionT, Options sample) noexcept(true);

template<int N, typename Options = Options<elem_size<N>>>
[[nodiscard]] auto
	list_where_subset(const Board<Options, N>&, const Options) noexcept(true);

template<int N, typename SectionT, typename Options = Options<elem_size<N>>>
[[nodiscard]] auto
	list_where_subset(const SectionT, const Options) noexcept(true);

template<int N, typename SectionT, typename Options = Options<elem_size<N>>>
[[nodiscard]] auto
	list_where_any_option(const SectionT, const Options sample) noexcept(true);

template<int N, typename Options = Options<elem_size<N>>, typename SectionT>
[[nodiscard]] Options appearance_once(SectionT section) noexcept;

template<int N, typename Options = Options<elem_size<N>>, typename InItr_>
[[nodiscard]] Options
	appearance_once(const InItr_ begin, const InItr_ end) noexcept;

template<int N, typename SectionT>
[[nodiscard]] auto appearance_sets(const SectionT section);

template<int N, typename InItr_>
[[nodiscard]] auto appearance_sets(const InItr_ begin, const InItr_ end);

//===----------------------------------------------------------------------===//

// List locations in [section] where [value] is an option
template<int N, typename SectionT>
inline auto list_where_option(
	const SectionT section,
	Value value,
	const ptrdiff_t rep_count /*= elem_size<N>*/)
{
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
		assert(rep_count > 0 && rep_count <= elem_size<N>);
	}
	const auto begin = section.cbegin();
	const auto end   = section.cend();

	return list_where_option<N>(begin, end, value, rep_count);
}

// List locations where [value] is an option
template<int N, typename ItrT>
auto list_where_option(
	const ItrT begin,
	const ItrT end,
	const Value value,
	ptrdiff_t rep_count /*= 0*/)
{
	using Options = Options<elem_size<N>>;
	{
		static_assert(traits::is_input<ItrT>);
		static_assert(
			traits::iterator_to<ItrT, const Options> ||
			traits::iterator_to<ItrT, Options>);
		assert(is_valid<N>(value));

		if (rep_count == 0)
			rep_count = std::distance(begin, end);
		else
			assert(rep_count > 0 && rep_count <= std::distance(begin, end));
	}

	std::vector<Location<N>> locations{};
	locations.reserve(gsl::narrow_cast<size_t>(rep_count));

	const auto check_option = [value](Options O) {
		return is_option(O, value);
	};

#if true
	// slightly faster, it saves one run of find_if on each execution,
	// but rep_count can be too small
	auto itr = begin;
	for (gsl::index i{0}; i < rep_count; ++i)
	{
		itr = std::find_if(itr, end, check_option);
		if (itr == end)
		{ // rep_count too large
			break;
		}
		locations.push_back(itr.location());
		++itr;
	}
	assert( // rep_count not too low
		itr == end || std::find_if(itr, end, check_option) == end);
#else
	for (auto last{std::find_if(begin, end, check_option)}; last != end;
		 last = std::find_if(last, end, check_option))
	{
		locations.push_back(last.location());
		++last;
	}
	assert( // rep_count not too low
		locations.size() <= gsl::narrow_cast<size_t>(rep_count));
#endif
	return locations;
}

// List locations in [section] containing [sample]
template<int N, typename SectionT, typename Options>
auto list_where_option( // NOLINT(bugprone-exception-escape)
	const SectionT section,
	const Options sample) noexcept(true)
{ // vector creation and growth could potentially throw, out of memory.
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
	}
	std::vector<Location<N>> locations{};
	locations.reserve(size_t{elem_size<N>});

	const auto check_option = [sample](Options O) noexcept {
		return sample == shared(O, sample);
	};
	const auto end = section.cend();

	for (auto last{std::find_if(section.cbegin(), end, check_option)};
		 last != end;
		 last = std::find_if(last, end, check_option))
	{
		if (!is_answer_fast(*last))
		{
			locations.push_back(last.location());
		}
		++last;
	}
	return locations;
}

// List locations in [section] equal to [sample]
template<int N, typename SectionT, typename Options>
auto list_where_equal( // NOLINT(bugprone-exception-escape)
	const SectionT section,
	const Options sample) noexcept(true)
{ // vector creation and growth could potentially throw, out of memory.
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
		static_assert(std::is_same_v<typename SectionT::value_type, Options>);
	}
	std::vector<Location<N>> locations{};
	locations.reserve(size_t{elem_size<N>});

	const auto end = section.cend();

	for (auto last{std::find(section.cbegin(), end, sample)}; last != end;
		 last = std::find(last, end, sample))
	{
		locations.push_back(last.location());
		++last;
	}
	return locations;
}

// All locations where available options are a subset of the sample.
template<int N, typename Options>
auto list_where_subset( // NOLINT(bugprone-exception-escape)
	const Board<Options, N>& board,
	const Options sample) noexcept(true)
{ // vector creation and growth could potentially throw, out of memory.
	using Location = Location<N>;
	std::vector<Location> list{};
	list.reserve(sample.count()); // minimum

	for (int i{}; i < full_size<N>; ++i)
	{
		const auto& other = board[Location(i)];
		if (!is_answer_fast(other) && // exclude processed answers
			(other == sample || shared(sample, other) == other))
		{
			list.push_back(Location(i));
		}
	}
	return list;
}

// All locations where available options are a subset of the sample.
template<int N, typename SectionT, typename Options>
auto list_where_subset( // NOLINT(bugprone-exception-escape)
	const SectionT section,
	const Options sample) noexcept(true)
{ // vector creation and growth could potentially throw, out of memory.
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
	}
	using Location = Location<N>;
	std::vector<Location> list{};
	list.reserve(sample.count());

	const auto end = section.cend();
	for (auto itr = section.cbegin(); itr != end; ++itr)
	{
		const auto& other = *itr;
		if (!is_answer_fast(other) && // exclude processed answers
			(other == sample || shared(sample, other) == other))
		{
			list.push_back(itr.location());
		}
	}
	return list;
}

// All locations containing an option present in [sample]
template<int N, typename SectionT, typename Options>
auto list_where_any_option( // NOLINT(bugprone-exception-escape)
	const SectionT section,
	const Options sample) noexcept(true)
{ // vector creation and growth could potentially throw, out of memory.
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
	}
	using Location = Location<N>;
	std::vector<Location> locations{};
	locations.reserve(sample.count_all());

	const auto check_option = [sample](Options O) noexcept {
		return is_answer_fast(O) ? false
								 : !(shared(O, sample).count_all() == 0u);
	};
	const auto end = section.cend();

	for (auto itr{std::find_if(section.cbegin(), end, check_option)};
		 itr != end;
		 itr = std::find_if(itr, end, check_option))
	{
		locations.push_back(itr.location());
		++itr;
	}
	return locations;
}

//===----------------------------------------------------------------------===//

//	returning options collected by appearance count in input-dataset
template<int N, typename InItr_>
auto appearance_sets(const InItr_ begin, const InItr_ end)
{
	// clang-format off
/*
Example illustration
Step 1) Collect
input			worker[n]
				|	[0]			|	[1]			|	[2]			|	[3]
1	100 000 001	|	100	000	001	|	000	000	000	|				|
2	110 100 010	|	110	100	011	|	100	000	000	|	000	000	000	|
3	010 000 011	|	110	100	011	|	110	000	011	|	000	000	000	|	000	000	000
4	000 000 011	|	110	100	011	|	110	000	011	|	000	000	011	|	000	000	000
5	101 100	111	|	111	100	111	|	110	100	011	|	100	000	011	|	000	000	011
6 A	000	001	000	|	111	101	111	|	110	101	011	|	100	001	011	|	000	001	011
7	101	100	110	|	111	101	111	|	111	101	111	|	100	101	011	|	100	001	011
8	100	110	010	|	111	111	111	|	111	101	111	|	100	101	011	|	100	101	011
9	010	000	101	|				|	111	101	111	|	110	101	111	|	100	101	011
				worker[n] contains options appearing more than n times
Step 2) flip
				|	000	000	000	|	000	010	000	|	001	010	000	|	011	010	100
532	419	365		|	==0x		|	==1x		|	<=2x		|	<=3x
				worker[n] contains options appearing n times or less
Step 3) XOR [n-1]
				|	== empty!	|	000	010	000	|	001	000	000	|	010	000	100
				|	==0x		|	==1x		|	==2x		|	==3x
				worker[n] contains options appearing exactly n times
// Q: What about the answer bit?
// A: Always true (==not answered)
//? Working with more or less than [elem_size] input elements?
// Less than 9: possible worker[0] is not empty
// Less than 3: no use for worker[3]
// More than 9: shouldn't be an issue
*/
	// clang-format on

	using Options = Options<elem_size<N>>;
	{
		static_assert(
			traits::iterator_to<InItr_, Options> ||
			traits::iterator_to<InItr_, const Options>);
	}
	// To limit processing time, counting up to N
	constexpr auto max = size_t{N}; // default: (9x9 board) up-to 3 times
	std::array<Options, max + 1> worker{};
	worker.fill(Options(Value{0}));

	// Collect options by appearance count
	// worker[n] contains options appearing more than n times (or answer)
	for (auto elem_itr = begin; elem_itr != end; ++elem_itr)
	{
		if (is_answer(*elem_itr))
		{
			// add answer to all
			for (auto& set : worker)
			{
				set += *elem_itr;
			} // OR
		}
		else
		{
			for (size_t i{max}; i > 0; --i)
			{
				worker.at(i) += (worker.at(i - 1) & *elem_itr); // OR( AND )
			}
			worker[0] += *elem_itr; // OR
		}
	}
	// flip -> worker[n] contains options appearing n times or less
	for (auto& option_set : worker)
	{
		option_set.flip();
	}
	// TODO test: can trigger on partial sections; improve?
	// fails if not all options exist
	assert(worker[0].count_all() == 0);

	// XOR -> worker[n] options appearing n times
	for (size_t i{max}; i > 1; --i)
	{
		worker.at(i).XOR(worker.at(i - 1));
		worker.at(i) += Options(Value{0}); // set not-answered
	}
	return worker;
}

//	returning options collected by appearance count in section
template<int N, typename SectionT>
inline auto appearance_sets(const SectionT section)
{ // referral function, creates iterators
	return appearance_sets<N>(section.cbegin(), section.cend());
}

// return a mask for values with a single appearance
template<int N, typename Options, typename InItr_>
Options appearance_once(const InItr_ begin, const InItr_ end) noexcept
{
	{
		static_assert(traits::is_input<InItr_>);
		static_assert(
			traits::iterator_to<InItr_, Options> ||
			traits::iterator_to<InItr_, const Options>);
	}
	Options sum(Value{0});    // helper all used
	Options worker(Value{0}); // multiple uses OR answer
	for (auto itr = begin; itr != end; ++itr)
	{
		if (is_answer(*itr))
		{
			worker = *itr + worker;
		}
		else
		{
			worker += (sum & *itr);
			sum += *itr;
		}
	}
	return worker.flip(); // multiple uses -> single-use
}

// range-based-for
template<int N, typename Options, typename SectionT>
Options appearance_once(SectionT section) noexcept
{
	{
		static_assert(Board_Section::traits::is_Section_v<SectionT>);
		static_assert(std::is_same_v<typename SectionT::value_type, Options>);
	}
	Options sum(Value{0});    // helper all used
	Options worker(Value{0}); // multiple uses OR answer
	for (const Options& item : section)
	{
		if (is_answer(item))
		{
			worker = item + worker; // OR
		}
		else
		{
			worker += (sum & item); // OR ( AND )
			sum += item;
		}
	}
	return worker.flip(); // multiple uses -> single-use
}

} // namespace Sudoku


/* multifit/fdfsolver.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2007 Brian Gough
 *
 * 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 <config.h>
#include <stdlib.h>
#include <string.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_multifit_nlin.h>

gsl_multifit_fdfsolver *
gsl_multifit_fdfsolver_alloc (const gsl_multifit_fdfsolver_type * T,
                              size_t n, size_t p)
{
  int status;

  gsl_multifit_fdfsolver * s;

  if (n < p)
    {
      GSL_ERROR_VAL ("insufficient data points, n < p", GSL_EINVAL, 0);
    }

  s = (gsl_multifit_fdfsolver *) calloc (1, sizeof (gsl_multifit_fdfsolver));
  if (s == 0)
    {
      GSL_ERROR_VAL ("failed to allocate space for multifit solver struct",
                     GSL_ENOMEM, 0);
    }

  s->x = gsl_vector_calloc (p);

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

  s->f = gsl_vector_calloc (n);

  if (s->f == 0)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to allocate space for f", GSL_ENOMEM, 0);
    }

  s->dx = gsl_vector_calloc (p);

  if (s->dx == 0)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to allocate space for dx", GSL_ENOMEM, 0);
    }

  s->g = gsl_vector_alloc (p);

  if (s->g == 0)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to allocate space for g", GSL_ENOMEM, 0);
    }

  s->sqrt_wts = gsl_vector_calloc (n);

  if (s->sqrt_wts == 0)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to allocate space for sqrt_wts", GSL_ENOMEM, 0);
    }

  s->state = calloc (1, T->size);

  if (s->state == 0)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to allocate space for multifit solver state",
                     GSL_ENOMEM, 0);
    }

  s->type = T ;

  status = (s->type->alloc)(s->state, n, p);

  if (status != GSL_SUCCESS)
    {
      gsl_multifit_fdfsolver_free (s);
      GSL_ERROR_VAL ("failed to set solver", status, 0);
    }

  s->fdf = NULL;

  s->niter = 0;

  return s;
}

int
gsl_multifit_fdfsolver_set (gsl_multifit_fdfsolver * s,
                            gsl_multifit_function_fdf * f,
                            const gsl_vector * x)
{
  return gsl_multifit_fdfsolver_wset(s, f, x, NULL);
}

int
gsl_multifit_fdfsolver_wset (gsl_multifit_fdfsolver * s,
                             gsl_multifit_function_fdf * f,
                             const gsl_vector * x,
                             const gsl_vector * wts)
{
  const size_t n = s->f->size;

  if (n != f->n)
    {
      GSL_ERROR ("function size does not match solver", GSL_EBADLEN);
    }
  else if (s->x->size != x->size)
    {
      GSL_ERROR ("vector length does not match solver", GSL_EBADLEN);
    }
  else if (wts != NULL && n != wts->size)
    {
      GSL_ERROR ("weight vector length does not match solver", GSL_EBADLEN);
    }
  else
    {
      size_t i;

      s->fdf = f;
      gsl_vector_memcpy(s->x, x);
      s->niter = 0;

      if (wts)
        {
          for (i = 0; i < n; ++i)
            {
              double wi = gsl_vector_get(wts, i);
              gsl_vector_set(s->sqrt_wts, i, sqrt(wi));
            }
        }
      else
        gsl_vector_set_all(s->sqrt_wts, 1.0);

      return (s->type->set) (s->state, s->sqrt_wts, s->fdf, s->x, s->f, s->dx);
    }
}

int
gsl_multifit_fdfsolver_iterate (gsl_multifit_fdfsolver * s)
{
  int status =
    (s->type->iterate) (s->state, s->sqrt_wts, s->fdf, s->x, s->f, s->dx);

  s->niter++;

  return status;
}

/*
gsl_multifit_fdfsolver_driver()
  Iterate the nonlinear least squares solver until completion

Inputs: s - fdfsolver
        maxiter - maximum iterations to allow
        xtol    - tolerance in step x
        gtol    - tolerance in gradient
        ftol    - tolerance in ||f||
        info    - (output) info flag on why iteration terminated
                  1 = stopped due to small step size ||dx|
                  2 = stopped due to small gradient
                  3 = stopped due to small change in f
                  GSL_ETOLX = ||dx|| has converged to within machine
                              precision (and xtol is too small)
                  GSL_ETOLG = ||g||_inf is smaller than machine
                              precision (gtol is too small)
                  GSL_ETOLF = change in ||f|| is smaller than machine
                              precision (ftol is too small)

Return: GSL_SUCCESS if converged, GSL_MAXITER if maxiter exceeded without
converging
*/
int
gsl_multifit_fdfsolver_driver (gsl_multifit_fdfsolver * s,
                               const size_t maxiter,
                               const double xtol,
                               const double gtol,
                               const double ftol,
                               int *info)
{
  int status;
  size_t iter = 0;

  do
    {
      status = gsl_multifit_fdfsolver_iterate (s);

      /*
       * if status is GSL_ENOPROG or GSL_SUCCESS, continue iterating,
       * otherwise the method has converged with a GSL_ETOLx flag
       */
      if (status != GSL_SUCCESS && status != GSL_ENOPROG)
        break;

      /* test for convergence */
      status = gsl_multifit_fdfsolver_test(s, xtol, gtol, ftol, info);
    }
  while (status == GSL_CONTINUE && ++iter < maxiter);

  /*
   * the following error codes mean that the solution has converged
   * to within machine precision, so record the error code in info
   * and return success
   */
  if (status == GSL_ETOLF || status == GSL_ETOLX || status == GSL_ETOLG)
    {
      *info = status;
      status = GSL_SUCCESS;
    }

  /* check if max iterations reached */
  if (iter >= maxiter && status != GSL_SUCCESS)
    status = GSL_EMAXITER;

  return status;
} /* gsl_multifit_fdfsolver_driver() */

int
gsl_multifit_fdfsolver_jac (gsl_multifit_fdfsolver * s, gsl_matrix * J)
{
  const size_t n = s->f->size;
  const size_t p = s->x->size;

  if (n != J->size1 || p != J->size2)
    {
      GSL_ERROR ("Jacobian dimensions do not match solver", GSL_EBADLEN);
    }
  else
    {
      return (s->type->jac) (s->state, J);
    }
} /* gsl_multifit_fdfsolver_jac() */

void
gsl_multifit_fdfsolver_free (gsl_multifit_fdfsolver * s)
{
  RETURN_IF_NULL (s);

  if (s->state)
    {
      (s->type->free) (s->state);
      free (s->state);
    }

  if (s->dx)
    gsl_vector_free (s->dx);

  if (s->x)
    gsl_vector_free (s->x);

  if (s->f)
    gsl_vector_free (s->f);

  if (s->sqrt_wts)
    gsl_vector_free (s->sqrt_wts);

  if (s->g)
    gsl_vector_free (s->g);

  free (s);
}

const char *
gsl_multifit_fdfsolver_name (const gsl_multifit_fdfsolver * s)
{
  return s->type->name;
}

gsl_vector *
gsl_multifit_fdfsolver_position (const gsl_multifit_fdfsolver * s)
{
  return s->x;
}

gsl_vector *
gsl_multifit_fdfsolver_residual (const gsl_multifit_fdfsolver * s)
{
  return s->f;
}

size_t
gsl_multifit_fdfsolver_niter (const gsl_multifit_fdfsolver * s)
{
  return s->niter;
}

/*
gsl_multifit_eval_wf()
  Compute residual vector y with user callback function, and apply
weighting transform if given:

y~ = sqrt(W) y

Inputs: fdf  - callback function
        x    - model parameters
        swts - weight matrix sqrt(W) = sqrt(diag(w1,w2,...,wn))
               set to NULL for unweighted fit
        y    - (output) (weighted) residual vector
               y_i = sqrt(w_i) f_i where f_i is unweighted residual
*/

int
gsl_multifit_eval_wf(gsl_multifit_function_fdf *fdf, const gsl_vector *x,
                     const gsl_vector *swts, gsl_vector *y)
{
  int s = ((*((fdf)->f)) (x, fdf->params, y));
  ++(fdf->nevalf);

  /* y <- sqrt(W) y */
  if (swts)
    gsl_vector_mul(y, swts);

  return s;
}

/*
gsl_multifit_eval_wdf()
  Compute Jacobian matrix J with user callback function, and apply
weighting transform if given:

J~ = sqrt(W) J

Inputs: fdf  - callback function
        x    - model parameters
        swts - weight matrix W = diag(w1,w2,...,wn)
               set to NULL for unweighted fit
        dy   - (output) (weighted) Jacobian matrix
               dy = sqrt(W) dy where dy is unweighted Jacobian
*/

int
gsl_multifit_eval_wdf(gsl_multifit_function_fdf *fdf, const gsl_vector *x,
                      const gsl_vector *swts, gsl_matrix *dy)
{
  int status = ((*((fdf)->df)) (x, fdf->params, dy));

  ++(fdf->nevaldf);

  /* J <- sqrt(W) J */
  if (swts)
    {
      const size_t n = swts->size;
      size_t i;

      for (i = 0; i < n; ++i)
        {
          double swi = gsl_vector_get(swts, i);
          gsl_vector_view v = gsl_matrix_row(dy, i);

          gsl_vector_scale(&v.vector, swi);
        }
    }

  return status;
}


/** @file header.h
 *
 */

#ifndef HEADER_H
#define HEADER_H

#define _GNU_SOURCE

#include <time.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <float.h>
#include <string.h>
#include <omp.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spline.h>
#include <gsl/gsl_interp2d.h>
#include <gsl/gsl_spline2d.h>
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_sf_legendre.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_monte.h>
#include <gsl/gsl_monte_vegas.h>
#include <gsl/gsl_odeiv2.h>
#include <gsl/gsl_roots.h>
#include <gsl/gsl_sf_expint.h>
#include <ctype.h>
#include "cuba.h"

#define PSC  		101L
#define ST 		    	102L
#define TK 		    	103L

#define GROWTH		104L
#define DERGROWTH		105L

#define NONLINEAR	   	106L
#define LINEAR		107L

#define GAUSSIAN		114L
#define NONGAUSSIAN	115L

#define INIT  		116L
#define LOCAL		117L
#define EQUILATERAL	118L
#define ORTHOGONAL	119L
#define QSF			120L
#define HS			121L
#define NGLOOP		122L
#define derNGLOOP		123L

#define QUADRATIC		124L
#define TIDE		125L
#define GAMMA		126L

#define LPOWER		127L
#define NLPOWER		128L
#define CDM 		90L
#define BA 			91L
#define TOT 		92L

#define CO10  		131L
#define CO21  		132L
#define CO32  		133L
#define CO43  		134L
#define CO54  		135L
#define CO65  		136L
#define CII 		137L

#define MATTER		138L
#define LINEMATTER	139L
#define LINE 		140L

#define DST			141L
#define GFILTER		142L
#define BSPLINE		143L

#define TREE		144L
#define LOOP		145L
#define WIR			146L
#define NOIR		147L

#define HALO 		148L

#define MEAN            149L
#define HMshot          150L
#define HMclust		151L

#define PS_KMIN   	1.e-5
#define PS_KMAX   	300.1
#define PS_ZMAX   	14.

#define CLEANUP        1
#define DO_NOT_EVALUATE -1.0
#define NPARS     6
#define MAXL 2000

extern struct globals gb;

/**
 * List of limHaloPT header files
 */
/// \cond DO_NOT_DOCUMENT
#include "../Class/include/class.h"
/// \endcond
#include "global_structs.h"
#include "hcubature.h"
#include "utilities.h"
#include "setup_teardown.h"
#include "cosmology.h"
#include "ir_res.h"
#include "line_ingredients.h"
#include "ps_halo_1loop.h"
#include "ps_line_hm.h"
#include "ps_line_pt.h"
#include "survey_specs.h"
#include "wnw_split.h"

/**
 * A structure passed to the integrators to hold the parameters fixed in the integration
 */
struct integrand_parameters
{
	double p1;
	double p2;
	double p3;
	double p4;
	double p5;
	double p6;
	double p7;
	double p8;
	double p9;
	double p10;
	double p11;
	long 	p12;
	long 	p13;
};

/**
 * Another structure passed to the integrators to hold the parameters fixed in the integration
 */
struct integrand_parameters2
{

	struct Cosmology *p1;
	struct Cosmology *p2;
	struct Cosmology *p3;

	double p4;
	double p5;
	double p6;
	double p7;
	double p8;
	double p9;
	double p10;
	double p11;
	double p12;

	long p13;
	long p14;
	long p15;
	long p16;
	long p17;
	long p18;

	int p19;

	double *p20;
	size_t p22;
};

#endif


/**
 *
 * @file core_ssbtype1cb.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 Azzam Haidar
 * @date 2011-05-15
 * @generated s Tue Jan  7 11:44:49 2014
 *
 **/
#include <lapacke.h>
#include "common.h"

#define A(m,n)   (A + LDA * (n) + ((m)-(n)))
#define V(m)     (V + (m))
#define TAU(m)   (TAU + (m))

/***************************************************************************//**
 *
 * @ingroup CORE_float
 *
 *  CORE_ssbtype1cb is a kernel that will operate on a region (triangle) of data
 *  bounded by st and ed. This kernel eliminate a column by an column-wise
 *  annihiliation, then it apply a left+right update on the hermitian triangle.
 *  Note that the column to be eliminated is located at st-1.
 *
 *  All detail are available on technical report or SC11 paper.
 *  Azzam Haidar, Hatem Ltaief, and Jack Dongarra. 2011.
 *  Parallel reduction to condensed forms for symmetric eigenvalue problems
 *  using aggregated fine-grained and memory-aware kernels. In Proceedings
 *  of 2011 International Conference for High Performance Computing,
 *  Networking, Storage and Analysis (SC '11). ACM, New York, NY, USA, ,
 *  Article 8 , 11 pages.
 *  http://doi.acm.org/10.1145/2063384.2063394
 *
 *******************************************************************************
 *
 * @param[in] N
 *          The order of the matrix A.
 *
 * @param[in] NB
 *          The size of the band.
 *
 * @param[in, out] A
 *          A pointer to the matrix A of size (2*NB+1)-by-N.
 *
 * @param[in] LDA
 *          The leading dimension of the matrix A. LDA >= max(1,2*NB+1)
 *
 * @param[out] V
 *          float array, dimension N if eigenvalue only
 *          requested or (LDV*blkcnt*Vblksiz) if Eigenvectors requested
 *          The Householder reflectors are stored in this array.
 *
 * @param[out] TAU
 *          float array, dimension (N).
 *          The scalar factors of the Householder reflectors are stored
 *          in this array.
 *
 * @param[in] st
 *          A pointer to the start index where this kernel will operate.
 *
 * @param[in] ed
 *          A pointer to the end index where this kernel will operate.
 *
 * @param[in] sweep
 *          The sweep number that is eliminated. it serve to calculate the
 *          pointer to the position where to store the Vs and Ts.
 *
 * @param[in] Vblksiz
 *          constant which correspond to the blocking used when applying the Vs.
 *          it serve to calculate the pointer to the position where to store the
 *          Vs and Ts.
 *
 * @param[in] WANTZ
 *          constant which indicate if Eigenvalue are requested or both
 *          Eigenvalue/Eigenvectors.
 *
 * @param[in] WORK
 *          Workspace of size nb.
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval <0 if -i, the i-th argument had an illegal value
 *
 ******************************************************************************/
/***************************************************************************
 *          TYPE 1-BAND Lower-columnwise-Householder
 ***************************************************************************/
void
CORE_ssbtype1cb(int N, int NB,
                float *A, int LDA,
                float *V, float *TAU,
                int st, int ed, int sweep, int Vblksiz, int WANTZ,
                float *WORK)
{
    int len, LDX;
    int blkid, vpos, taupos, tpos;

    /* find the pointer to the Vs and Ts as stored by the bulgechasing
     * note that in case no eigenvector required V and T are stored
     * on a vector of size N
     * */
     if( WANTZ == 0 ) {
         vpos   = ((sweep+1)%2)*N + st;
         taupos = ((sweep+1)%2)*N + st;
     } else {
         findVTpos(N, NB, Vblksiz, sweep, st,
                   &vpos, &taupos, &tpos, &blkid);
     }

    LDX = LDA-1;
    len = ed-st+1;
    *V(vpos) = 1.;

    memcpy( V(vpos+1), A(st+1, st-1), (len-1)*sizeof(float) );
    memset( A(st+1, st-1), 0, (len-1)*sizeof(float) );

    /* Eliminate the col  at st-1 */
    LAPACKE_slarfg_work(len, A(st, st-1), V(vpos+1), 1, TAU(taupos) );

    /* Apply left and right on A(st:ed,st:ed) */
    CORE_slarfy(len, A(st,st), LDX, V(vpos), TAU(taupos), WORK);

    return;
}
/***************************************************************************/
#undef A
#undef V
#undef TAU


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

int main(void)
{
	float a[] = { 1, 2, 3, 4, 5, 6 };
	float b[] = { 0, 0, 0, 0, 0, 0 };
	const int n = sizeof a / sizeof a[0];
	int i;

	cblas_scopy(n/2, a, 2, b, 2);	/* copy every other element */
	for (i = 0; i < n; ++i)
		printf("%f ", b[i]);
	putchar('\n');

	return 0;
}


/**
 *
 * @file core_stsmqr_sytra1.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 Hatem Ltaief
 * @author Mathieu Faverge
 * @author Jakub Kurzak
 * @author Azzam Haidar
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:44:48 2014
 *
 **/
#include <lapacke.h>
#include "common.h"
#undef COMPLEX
#define REAL

/***************************************************************************//**
 *
 * @ingroup CORE_float
 *
 *  CORE_stsmqr_sytra1: see CORE_stsmqr
 *
 *  This kernel applies a left transformation on | A1'|
 *                                               | A2 |
 *
 * Needs therefore to make the explicit transpose of A1 before
 * and after the application of the block of reflectors
 * Can be further optimized by changing accordingly the underneath
 * kernel ztsrfb!
 *
 *******************************************************************************
 *
 * @param[in] side
 *         @arg PlasmaLeft  : apply Q or Q**T from the Left;
 *         @arg PlasmaRight : apply Q or Q**T from the Right.
 *
 * @param[in] trans
 *         @arg PlasmaNoTrans   :  No transpose, apply Q;
 *         @arg PlasmaTrans :  ConjTranspose, apply Q**T.
 *
 * @param[in] m1
 *         The number of rows of the tile A1. M1 >= 0.
 *
 * @param[in] n1
 *         The number of columns of the tile A1. N1 >= 0.
 *
 * @param[in] m2
 *         The number of rows of the tile A2. M2 >= 0.
 *         M2 = M1 if side == PlasmaRight.
 *
 * @param[in] n2
 *         The number of columns of the tile A2. N2 >= 0.
 *         N2 = N1 if side == PlasmaLeft.
 *
 * @param[in] k
 *         The number of elementary reflectors whose product defines
 *         the matrix Q.
 *
 * @param[in] ib
 *         The inner-blocking size.  IB >= 0.
 *
 * @param[in,out] A1
 *         On entry, the M1-by-N1 tile A1.
 *         On exit, A1 is overwritten by the application of Q.
 *
 * @param[in] lda1
 *         The leading dimension of the array A1. LDA1 >= max(1,M1).
 *
 * @param[in,out] A2
 *         On entry, the M2-by-N2 tile A2.
 *         On exit, A2 is overwritten by the application of Q.
 *
 * @param[in] lda2
 *         The leading dimension of the tile A2. LDA2 >= max(1,M2).
 *
 * @param[in] V
 *         The i-th row must contain the vector which defines the
 *         elementary reflector H(i), for i = 1,2,...,k, as returned by
 *         CORE_STSQRT in the first k columns of its array argument V.
 *
 * @param[in] ldv
 *         The leading dimension of the array V. LDV >= max(1,K).
 *
 * @param[in] T
 *         The IB-by-N1 triangular factor T of the block reflector.
 *         T is upper triangular by block (economic storage);
 *         The rest of the array is not referenced.
 *
 * @param[in] ldt
 *         The leading dimension of the array T. LDT >= IB.
 *
 * @param[out] WORK
 *         Workspace array of size
 *             LDWORK-by-N1 if side == PlasmaLeft
 *             LDWORK-by-IB if side == PlasmaRight
 *
 * @param[in] ldwork
 *         The leading dimension of the array WORK.
 *             LDWORK >= max(1,IB) if side == PlasmaLeft
 *             LDWORK >= max(1,M1) if side == PlasmaRight
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval <0 if -i, the i-th argument had an illegal value
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_stsmqr_sytra1 = PCORE_stsmqr_sytra1
#define CORE_stsmqr_sytra1 PCORE_stsmqr_sytra1
#define CORE_stsmqr PCORE_stsmqr
int  CORE_stsmqr(PLASMA_enum side, PLASMA_enum trans,
                 int M1, int N1, int M2, int N2, int K, int IB,
                 float *A1, int LDA1,
                 float *A2, int LDA2,
                 const float *V, int LDV,
                 const float *T, int LDT,
                 float *WORK, int LDWORK);
#endif
int CORE_stsmqr_sytra1( PLASMA_enum side, PLASMA_enum trans,
                        int m1, int n1, int m2, int n2,
                        int k, int ib,
                        float *A1, int lda1,
                        float *A2, int lda2,
                        const float *V, int ldv,
                        const float *T, int ldt,
                        float *WORK, int ldwork)
{
    int i, j;

    if ( (m1 != n1) ) {
        coreblas_error(3, "Illegal value of M1, N1");
        return -3;
    }

    /* in-place transposition of A1 */
    for (j = 0; j < n1; j++){
        A1[j + j*lda1] = (A1[j + j*lda1]);

        for (i = j+1; i < m1; i++){
            *WORK = *(A1 + i + j*lda1);
            *(A1 + i + j*lda1) = (*(A1 + j + i*lda1));
            *(A1 + j + i*lda1) = (*WORK);
        }
    }

    CORE_stsmqr(side, trans, m1, n1, m2, n2, k, ib, A1, lda1, A2, lda2, V, ldv, T, ldt, WORK, ldwork);

    /* in-place transposition of A1 */
    for (j = 0; j < n1; j++){
        A1[j + j*lda1] = (A1[j + j*lda1]);

        for (i = j+1; i < m1; i++){
            *WORK = *(A1 + i + j*lda1);
            *(A1 + i + j*lda1) = (*(A1 + j + i*lda1));
            *(A1 + j + i*lda1) = (*WORK);
        }
    }

    return PLASMA_SUCCESS;
}


/* movstat/movqqr.c
 *
 * Compute moving q-quantile range
 *
 * Copyright (C) 2018 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 <config.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_movstat.h>
#include <gsl/gsl_sort.h>
#include <gsl/gsl_statistics.h>

/*
gsl_movstat_qqr()
  Apply a moving q-quantile range to an input vector

Inputs: endtype - how to handle end points
        x       - input vector, size n
        q       - quantile \in [0,0.5]
        xqqr    - (output) vector of q-quantile ranges of x, size n
                  xqqr_i = q-quantile range of i-th window:
        w       - workspace
*/

int
gsl_movstat_qqr(const gsl_movstat_end_t endtype, const gsl_vector * x, const double q,
                gsl_vector * xqqr, gsl_movstat_workspace * w)
{
  if (x->size != xqqr->size)
    {
      GSL_ERROR("x and xqqr vectors must have same length", GSL_EBADLEN);
    }
  else if (q < 0.0 || q > 0.5)
    {
      GSL_ERROR("q must be between 0 and 0.5", GSL_EDOM);
    }
  else
    {
      double qq = q;
      int status = gsl_movstat_apply_accum(endtype, x, gsl_movstat_accum_qqr, (void *) &qq, xqqr, NULL, w);
      return status;
    }
}


/* histogram/test.c
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Brian Gough
 *
 * 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 <stdlib.h>
#include <stdio.h>
#include <gsl/gsl_histogram.h>
#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>

void test1d (void);
void test2d (void);
void test1d_resample (void);
void test2d_resample (void);
void test1d_trap (void);
void test2d_trap (void);

int
main (void)
{
  test1d();
  test2d();
  test1d_resample();
  test2d_resample();
  test1d_trap();
  test2d_trap();

  exit (gsl_test_summary ());
}


#ifndef boundary_h
#define boundary_h

#include <petsc.h>

typedef PetscErrorCode BCFunc(PetscInt, PetscReal, const PetscReal *, PetscInt,
                              PetscScalar *, void *);
BCFunc BCMMS, BCZero, BCClamp;

// -----------------------------------------------------------------------------
// Boundary Functions
// -----------------------------------------------------------------------------
// Note: If additional boundary conditions are added, an update is needed in
//         elasticity.h for the boundaryOptions variable.

// BCMMS - boundary function
// Values on all points of the mesh is set based on given solution below
// for u[0], u[1], u[2]
PetscErrorCode BCMMS(PetscInt dim, PetscReal load_increment,
                     const PetscReal coords[], PetscInt num_comp_u,
                     PetscScalar *u, void *ctx);

// BCClamp - fix boundary values with affine transformation at fraction of load
//   increment
PetscErrorCode BCClamp(PetscInt dim, PetscReal load_increment,
                       const PetscReal coords[], PetscInt num_comp_u,
                       PetscScalar *u, void *ctx);

#endif //boundary_h


/**
 *
 * @file core_ssyrfb.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 Hatem Ltaief
 * @date 2010-11-15
 * @generated s Tue Jan  7 11:44:48 2014
 *
 **/
#include <lapacke.h>
#include "common.h"
#undef COMPLEX
#define REAL

/***************************************************************************//**
 *
 * @ingroup CORE_float
 *
 *  CORE_ssyrfb overwrites the symmetric complex N-by-N tile C with
 *
 *    Q**T*C*Q
 *
 *  where Q is a complex unitary matrix defined as the product of k
 *  elementary reflectors
 *
 *    Q = H(1) H(2) . . . H(k)
 *
 *  as returned by CORE_sgeqrt. Only PlasmaLower supported!
 *
 *******************************************************************************
 *
 * @param[in] uplo
 *         @arg PlasmaLower : the upper part of the symmetric matrix C
 *                            is not referenced.
 *         @arg PlasmaUpper : the lower part of the symmetric matrix C
 *                            is not referenced (not supported).
 *
 * @param[in] n
 *         The number of rows/columns of the tile C.  N >= 0.
 *
 * @param[in] k
 *         The number of elementary reflectors whose product defines
 *         the matrix Q. K >= 0.
 *
 * @param[in] ib
 *         The inner-blocking size.  IB >= 0.
 *
 * @param[in] nb
 *         The blocking size.  NB >= 0.
 *
 * @param[in] A
 *         The i-th column must contain the vector which defines the
 *         elementary reflector H(i), for i = 1,2,...,k, as returned by
 *         CORE_sgeqrt in the first k columns of its array argument A.
 *
 * @param[in] lda
 *         The leading dimension of the array A. LDA >= max(1,N).
 *
 * @param[in] T
 *         The IB-by-K triangular factor T of the block reflector.
 *         T is upper triangular by block (economic storage);
 *         The rest of the array is not referenced.
 *
 * @param[in] ldt
 *         The leading dimension of the array T. LDT >= IB.
 *
 * @param[in,out] C
 *         On entry, the symmetric N-by-N tile C.
 *         On exit, C is overwritten by Q**T*C*Q.
 *
 * @param[in] ldc
 *         The leading dimension of the array C. LDC >= max(1,M).
 *
 * @param[in,out] WORK
 *         On exit, if INFO = 0, WORK(1) returns the optimal LDWORK.
 *
 * @param[in] ldwork
 *         The dimension of the array WORK. LDWORK >= max(1,N);
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval <0 if -i, the i-th argument had an illegal value
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_ssyrfb = PCORE_ssyrfb
#define CORE_ssyrfb PCORE_ssyrfb
#define CORE_sormlq PCORE_sormlq
#define CORE_sormqr PCORE_sormqr
int  CORE_sormlq(PLASMA_enum side, PLASMA_enum trans,
                 int M, int N, int IB, int K,
                 const float *V, int LDV,
                 const float *T, int LDT,
                 float *C, int LDC,
                 float *WORK, int LDWORK);
int  CORE_sormqr(PLASMA_enum side, PLASMA_enum trans,
                 int M, int N, int K, int IB,
                 const float *V, int LDV,
                 const float *T, int LDT,
                 float *C, int LDC,
                 float *WORK, int LDWORK);
#endif
int CORE_ssyrfb( PLASMA_enum uplo, int n,
                 int k, int ib, int nb,
                 const float *A, int lda,
                 const float *T, int ldt,
                 float *C, int ldc,
                 float *WORK, int ldwork )
{
    float tmp;
    int i, j;

    /* Check input arguments */
    if ((uplo != PlasmaUpper) && (uplo != PlasmaLower)) {
        coreblas_error(1, "Illegal value of uplo");
        return -1;
    }
    if (n < 0) {
        coreblas_error(2, "Illegal value of n");
        return -2;
    }
    if (k < 0) {
        coreblas_error(3, "Illegal value of k");
        return -3;
    }
    if (ib < 0) {
        coreblas_error(4, "Illegal value of ib");
        return -4;
    }
    if (nb < 0) {
        coreblas_error(5, "Illegal value of nb");
        return -5;
    }
    if ( (lda < max(1,n)) && (n > 0) ) {
        coreblas_error(7, "Illegal value of lda");
        return -7;
    }
    if ( (ldt < max(1,ib)) && (ib > 0) ) {
        coreblas_error(9, "Illegal value of ldt");
        return -9;
    }
    if ( (ldc < max(1,n)) && (n > 0) ) {
        coreblas_error(11, "Illegal value of ldc");
        return -11;
    }

    if (uplo == PlasmaLower) {
        /* Rebuild the symmetric block: WORK <- C */
        for (j = 0; j < n; j++) {
            *(WORK + j + j * ldwork) =  *(C + ldc*j + j);
            for (i = j+1; i < n; i++){
                tmp = *(C + i + j*ldc);
                *(WORK + i + j * ldwork) = tmp;
                *(WORK + j + i * ldwork) = ( tmp );
            }
        }

        /* Left */
        CORE_sormqr(PlasmaLeft, PlasmaTrans, n, n, k, ib,
                    A, lda, T, ldt, WORK, ldwork, WORK+nb*ldwork, ldwork);
        /* Right */
        CORE_sormqr(PlasmaRight, PlasmaNoTrans, n, n, k, ib,
                    A, lda, T, ldt, WORK, ldwork, WORK+nb*ldwork, ldwork);

        /*
         * Copy back the final result to the lower part of C
         */
        LAPACKE_slacpy_work( LAPACK_COL_MAJOR, lapack_const(PlasmaLower), n, n, WORK, ldwork, C, ldc );
    }
    else {
        /* Rebuild the symmetric block: WORK <- C */
        for (j = 0; j < n; j++) {
            for (i = 0; i < j; i++){
                tmp = *(C + i + j*ldc);
                *(WORK + i + j * ldwork) = tmp;
                *(WORK + j + i * ldwork) = ( tmp );
            }
            *(WORK + j + j * ldwork) =  *(C + ldc*j + j);
        }

        /* Right */
        CORE_sormlq(PlasmaRight, PlasmaTrans, n, n, k, ib,
                    A, lda, T, ldt, WORK, ldwork, WORK+nb*ldwork, ldwork);
        /* Left */
        CORE_sormlq(PlasmaLeft, PlasmaNoTrans, n, n, k, ib,
                    A, lda, T, ldt, WORK, ldwork, WORK+nb*ldwork, ldwork);

        /*
         * Copy back the final result to the upper part of C
         */
        LAPACKE_slacpy_work( LAPACK_COL_MAJOR, lapack_const(PlasmaUpper), n, n, WORK, ldwork, C, ldc );
    }
    return 0;
}