/* specfunc/bessel.c
 *
 * 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 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/* Author:  G. Jungman */
/* Miscellaneous support functions for Bessel function evaluations.
 */
#include <config.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_errno.h>
#include "gsl_sf_airy.h"
#include "gsl_sf_elementary.h"
#include "gsl_sf_exp.h"
#include "gsl_sf_gamma.h"
#include "gsl_sf_trig.h"

#include "error.h"

#include "bessel_amp_phase.h"
#include "bessel_temme.h"
#include "bessel.h"

#define CubeRoot2_  1.25992104989487316476721060728

/* Debye functions [Abramowitz+Stegun, 9.3.9-10] */

inline static double
debye_u1(const double * tpow)
{
  return (3.0*tpow[1] - 5.0*tpow[3])/24.0;
}

inline static double
debye_u2(const double * tpow)
{
  return (81.0*tpow[2] - 462.0*tpow[4] + 385.0*tpow[6])/1152.0;
}

inline
static double debye_u3(const double * tpow)
{
  return (30375.0*tpow[3] - 369603.0*tpow[5] + 765765.0*tpow[7] - 425425.0*tpow[9])/414720.0;
}

inline
static double debye_u4(const double * tpow)
{
  return (4465125.0*tpow[4] - 94121676.0*tpow[6] + 349922430.0*tpow[8] -
          446185740.0*tpow[10] + 185910725.0*tpow[12])/39813120.0;
}

inline
static double debye_u5(const double * tpow)
{
  return (1519035525.0*tpow[5]     - 49286948607.0*tpow[7] +
          284499769554.0*tpow[9]   - 614135872350.0*tpow[11] +
          566098157625.0*tpow[13]  - 188699385875.0*tpow[15])/6688604160.0;
}

#if 0
inline
static double debye_u6(const double * tpow)
{
  return (2757049477875.0*tpow[6] - 127577298354750.0*tpow[8] +
          1050760774457901.0*tpow[10] - 3369032068261860.0*tpow[12] +
          5104696716244125.0*tpow[14] - 3685299006138750.0*tpow[16] +
          1023694168371875.0*tpow[18])/4815794995200.0;
}
#endif

/*-*-*-*-*-*-*-*-*-*-*-* Functions with Error Codes *-*-*-*-*-*-*-*-*-*-*-*/

int
gsl_sf_bessel_IJ_taylor_e(const double nu, const double x,
                             const int sign,
                             const int kmax,
                             const double threshold,
                             gsl_sf_result * result
                             )
{
  /* CHECK_POINTER(result) */

  if(nu < 0.0 || x < 0.0) {
    DOMAIN_ERROR(result);
  }
  else if(x == 0.0) {
    if(nu == 0.0) {
      result->val = 1.0;
      result->err = 0.0;
    }
    else {
      result->val = 0.0;
      result->err = 0.0;
    }
    return GSL_SUCCESS;
  }
  else {
    gsl_sf_result prefactor;   /* (x/2)^nu / Gamma(nu+1) */
    gsl_sf_result sum;

    int stat_pre;
    int stat_sum;
    int stat_mul;

    if(nu == 0.0) {
      prefactor.val = 1.0;
      prefactor.err = 0.0;
      stat_pre = GSL_SUCCESS;
    }
    else if(nu < INT_MAX-1) {
      /* Separate the integer part and use
       * y^nu / Gamma(nu+1) = y^N /N! y^f / (N+1)_f,
       * to control the error.
       */
      const int    N = (int)floor(nu + 0.5);
      const double f = nu - N;
      gsl_sf_result poch_factor;
      gsl_sf_result tc_factor;
      const int stat_poch = gsl_sf_poch_e(N+1.0, f, &poch_factor);
      const int stat_tc   = gsl_sf_taylorcoeff_e(N, 0.5*x, &tc_factor);
      const double p = pow(0.5*x,f);
      prefactor.val  = tc_factor.val * p / poch_factor.val;
      prefactor.err  = tc_factor.err * p / poch_factor.val;
      prefactor.err += fabs(prefactor.val) / poch_factor.val * poch_factor.err;
      prefactor.err += 2.0 * GSL_DBL_EPSILON * fabs(prefactor.val);
      stat_pre = GSL_ERROR_SELECT_2(stat_tc, stat_poch);
    }
    else {
      gsl_sf_result lg;
      const int stat_lg = gsl_sf_lngamma_e(nu+1.0, &lg);
      const double term1  = nu*log(0.5*x);
      const double term2  = lg.val;
      const double ln_pre = term1 - term2;
      const double ln_pre_err = GSL_DBL_EPSILON * (fabs(term1)+fabs(term2)) + lg.err;
      const int stat_ex = gsl_sf_exp_err_e(ln_pre, ln_pre_err, &prefactor);
      stat_pre = GSL_ERROR_SELECT_2(stat_ex, stat_lg);
    }

    /* Evaluate the sum.
     * [Abramowitz+Stegun, 9.1.10]
     * [Abramowitz+Stegun, 9.6.7]
     */
    {
      const double y = sign * 0.25 * x*x;
      double sumk = 1.0;
      double term = 1.0;
      int k;

      for(k=1; k<=kmax; k++) {
        term *= y/((nu+k)*k);
        sumk += term;
        if(fabs(term/sumk) < threshold) break;
      }

      sum.val = sumk;
      sum.err = threshold * fabs(sumk);

      stat_sum = ( k >= kmax ? GSL_EMAXITER : GSL_SUCCESS );
    }

    stat_mul = gsl_sf_multiply_err_e(prefactor.val, prefactor.err,
                                        sum.val, sum.err,
                                        result);

    return GSL_ERROR_SELECT_3(stat_mul, stat_pre, stat_sum);
  }
}

/* x >> nu*nu+1
 * error ~ O( ((nu*nu+1)/x)^3 )
 *
 * empirical error analysis:
 *   choose  GSL_ROOT3_MACH_EPS * x > (nu*nu + 1)
 *
 * This is not especially useful. When the argument gets
 * large enough for this to apply, the cos() and sin()
 * start loosing digits. However, this seems inevitable
 * for this particular method.
 */
int
gsl_sf_bessel_Jnu_asympx_e(const double nu, const double x, gsl_sf_result * result)
{
  double mu   = 4.0*nu*nu;
  double mum1 = mu-1.0;
  double mum9 = mu-9.0;
  double chi = x - (0.5*nu + 0.25)*M_PI;
  double P   = 1.0 - mum1*mum9/(128.0*x*x);
  double Q   = mum1/(8.0*x);
  double pre = sqrt(2.0/(M_PI*x));
  double c   = cos(chi);
  double s   = sin(chi);
  double r   = mu/x;
  result->val  = pre * (c*P - s*Q);
  result->err  = pre * GSL_DBL_EPSILON * (fabs(c*P) + fabs(s*Q));
  result->err += pre * fabs(0.1*r*r*r);
  return GSL_SUCCESS;
}

/* x >> nu*nu+1
 */
int
gsl_sf_bessel_Ynu_asympx_e(const double nu, const double x, gsl_sf_result * result)
{
  double ampl;
  double theta;
  double alpha = x;
  double beta  = -0.5*nu*M_PI;
  int stat_a = gsl_sf_bessel_asymp_Mnu_e(nu, x, &ampl);
  int stat_t = gsl_sf_bessel_asymp_thetanu_corr_e(nu, x, &theta);
  double sin_alpha = sin(alpha);
  double cos_alpha = cos(alpha);
  double sin_chi   = sin(beta + theta);
  double cos_chi   = cos(beta + theta);
  double sin_term     = sin_alpha * cos_chi + sin_chi * cos_alpha;
  double sin_term_mag = fabs(sin_alpha * cos_chi) + fabs(sin_chi * cos_alpha);
  result->val  = ampl * sin_term;
  result->err  = fabs(ampl) * GSL_DBL_EPSILON * sin_term_mag;
  result->err += fabs(result->val) * 2.0 * GSL_DBL_EPSILON;

  if(fabs(alpha) > 1.0/GSL_DBL_EPSILON) {
    result->err *= 0.5 * fabs(alpha);
  }
  else if(fabs(alpha) > 1.0/GSL_SQRT_DBL_EPSILON) {
    result->err *= 256.0 * fabs(alpha) * GSL_SQRT_DBL_EPSILON;
  }

  return GSL_ERROR_SELECT_2(stat_t, stat_a);
}

/* x >> nu*nu+1
 */
int
gsl_sf_bessel_Inu_scaled_asympx_e(const double nu, const double x, gsl_sf_result * result)
{
  double mu   = 4.0*nu*nu;
  double mum1 = mu-1.0;
  double mum9 = mu-9.0;
  double pre  = 1.0/sqrt(2.0*M_PI*x);
  double r    = mu/x;
  result->val = pre * (1.0 - mum1/(8.0*x) + mum1*mum9/(128.0*x*x));
  result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val) + pre * fabs(0.1*r*r*r);
  return GSL_SUCCESS;
}

/* x >> nu*nu+1
 */
int
gsl_sf_bessel_Knu_scaled_asympx_e(const double nu, const double x, gsl_sf_result * result)
{
  double mu   = 4.0*nu*nu;
  double mum1 = mu-1.0;
  double mum9 = mu-9.0;
  double pre  = sqrt(M_PI/(2.0*x));
  double r    = nu/x;
  result->val = pre * (1.0 + mum1/(8.0*x) + mum1*mum9/(128.0*x*x));
  result->err = 2.0 * GSL_DBL_EPSILON * fabs(result->val) + pre * fabs(0.1*r*r*r);
  return GSL_SUCCESS;
}

/* nu -> Inf; uniform in x > 0  [Abramowitz+Stegun, 9.7.7]
 *
 * error:
 *   The error has the form u_N(t)/nu^N  where  0 <= t <= 1.
 *   It is not hard to show that |u_N(t)| is small for such t.
 *   We have N=6 here, and |u_6(t)| < 0.025, so the error is clearly
 *   bounded by 0.025/nu^6. This gives the asymptotic bound on nu
 *   seen below as nu ~ 100. For general MACH_EPS it will be
 *                     nu > 0.5 / MACH_EPS^(1/6)
 *   When t is small, the bound is even better because |u_N(t)| vanishes
 *   as t->0. In fact u_N(t) ~ C t^N as t->0, with C ~= 0.1.
 *   We write
 *                     err_N <= min(0.025, C(1/(1+(x/nu)^2))^3) / nu^6
 *   therefore
 *                     min(0.29/nu^2, 0.5/(nu^2+x^2)) < MACH_EPS^{1/3}
 *   and this is the general form.
 *
 * empirical error analysis, assuming 14 digit requirement:
 *   choose   x > 50.000 nu   ==>  nu >   3
 *   choose   x > 10.000 nu   ==>  nu >  15
 *   choose   x >  2.000 nu   ==>  nu >  50
 *   choose   x >  1.000 nu   ==>  nu >  75
 *   choose   x >  0.500 nu   ==>  nu >  80
 *   choose   x >  0.100 nu   ==>  nu >  83
 *
 * This makes sense. For x << nu, the error will be of the form u_N(1)/nu^N,
 * since the polynomial term will be evaluated near t=1, so the bound
 * on nu will become constant for small x. Furthermore, increasing x with
 * nu fixed will decrease the error.
 */
int
gsl_sf_bessel_Inu_scaled_asymp_unif_e(const double nu, const double x, gsl_sf_result * result)
{
  int i;
  double z = x/nu;
  double root_term = sqrt(1.0 + z*z);
  double pre = 1.0/sqrt(2.0*M_PI*nu * root_term);
  double eta = root_term + log(z/(1.0+root_term));
  double ex_arg = ( z < 1.0/GSL_ROOT3_DBL_EPSILON ? nu*(-z + eta) : -0.5*nu/z*(1.0 - 1.0/(12.0*z*z)) );
  gsl_sf_result ex_result;
  int stat_ex = gsl_sf_exp_e(ex_arg, &ex_result);
  if(stat_ex == GSL_SUCCESS) {
    double t = 1.0/root_term;
    double sum;
    double tpow[16];
    tpow[0] = 1.0;
    for(i=1; i<16; i++) tpow[i] = t * tpow[i-1];
    sum = 1.0 + debye_u1(tpow)/nu + debye_u2(tpow)/(nu*nu) + debye_u3(tpow)/(nu*nu*nu)
          + debye_u4(tpow)/(nu*nu*nu*nu) + debye_u5(tpow)/(nu*nu*nu*nu*nu);
    result->val  = pre * ex_result.val * sum;
    result->err  = pre * ex_result.val / (nu*nu*nu*nu*nu*nu);
    result->err += pre * ex_result.err * fabs(sum);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    result->val = 0.0;
    result->err = 0.0;
    return stat_ex;
  }
}

/* nu -> Inf; uniform in x > 0  [Abramowitz+Stegun, 9.7.8]
 *
 * error:
 *   identical to that above for Inu_scaled
 */
int
gsl_sf_bessel_Knu_scaled_asymp_unif_e(const double nu, const double x, gsl_sf_result * result)
{
  int i;
  double z = x/nu;
  double root_term = sqrt(1.0 + z*z);
  double pre = sqrt(M_PI/(2.0*nu*root_term));
  double eta = root_term + log(z/(1.0+root_term));
  double ex_arg = ( z < 1.0/GSL_ROOT3_DBL_EPSILON ? nu*(z - eta) : 0.5*nu/z*(1.0 + 1.0/(12.0*z*z)) );
  gsl_sf_result ex_result;
  int stat_ex = gsl_sf_exp_e(ex_arg, &ex_result);
  if(stat_ex == GSL_SUCCESS) {
    double t = 1.0/root_term;
    double sum;
    double tpow[16];
    tpow[0] = 1.0;
    for(i=1; i<16; i++) tpow[i] = t * tpow[i-1];
    sum = 1.0 - debye_u1(tpow)/nu + debye_u2(tpow)/(nu*nu) - debye_u3(tpow)/(nu*nu*nu)
          + debye_u4(tpow)/(nu*nu*nu*nu) - debye_u5(tpow)/(nu*nu*nu*nu*nu);
    result->val  = pre * ex_result.val * sum;
    result->err  = pre * ex_result.err * fabs(sum);
    result->err += pre * ex_result.val / (nu*nu*nu*nu*nu*nu);
    result->err += 2.0 * GSL_DBL_EPSILON * fabs(result->val);
    return GSL_SUCCESS;
  }
  else {
    result->val = 0.0;
    result->err = 0.0;
    return stat_ex;
  }
}

/* Evaluate J_mu(x),J_{mu+1}(x) and Y_mu(x),Y_{mu+1}(x)  for |mu| < 1/2
 */
int
gsl_sf_bessel_JY_mu_restricted(const double mu, const double x,
                               gsl_sf_result * Jmu, gsl_sf_result * Jmup1,
                               gsl_sf_result * Ymu, gsl_sf_result * Ymup1)
{
  /* CHECK_POINTER(Jmu) */
  /* CHECK_POINTER(Jmup1) */
  /* CHECK_POINTER(Ymu) */
  /* CHECK_POINTER(Ymup1) */

  if(x < 0.0 || fabs(mu) > 0.5) {
    Jmu->val   = 0.0;
    Jmu->err   = 0.0;
    Jmup1->val = 0.0;
    Jmup1->err = 0.0;
    Ymu->val   = 0.0;
    Ymu->err   = 0.0;
    Ymup1->val = 0.0;
    Ymup1->err = 0.0;
    GSL_ERROR ("error", GSL_EDOM);
  }
  else if(x == 0.0) {
    if(mu == 0.0) {
      Jmu->val   = 1.0;
      Jmu->err   = 0.0;
    }
    else {
      Jmu->val   = 0.0;
      Jmu->err   = 0.0;
    }
    Jmup1->val = 0.0;
    Jmup1->err = 0.0;
    Ymu->val   = 0.0;
    Ymu->err   = 0.0;
    Ymup1->val = 0.0;
    Ymup1->err = 0.0;
    GSL_ERROR ("error", GSL_EDOM);
  }
  else {
    int stat_Y;
    int stat_J;

    if(x < 2.0) {
      /* Use Taylor series for J and the Temme series for Y.
       * The Taylor series for J requires nu > 0, so we shift
       * up one and use the recursion relation to get Jmu, in
       * case mu < 0.
       */
      gsl_sf_result Jmup2;
      int stat_J1 = gsl_sf_bessel_IJ_taylor_e(mu+1.0, x, -1, 100, GSL_DBL_EPSILON,  Jmup1);
      int stat_J2 = gsl_sf_bessel_IJ_taylor_e(mu+2.0, x, -1, 100, GSL_DBL_EPSILON, &Jmup2);
      double c = 2.0*(mu+1.0)/x;
      Jmu->val  = c * Jmup1->val - Jmup2.val;
      Jmu->err  = c * Jmup1->err + Jmup2.err;
      Jmu->err += 2.0 * GSL_DBL_EPSILON * fabs(Jmu->val);
      stat_J = GSL_ERROR_SELECT_2(stat_J1, stat_J2);
      stat_Y = gsl_sf_bessel_Y_temme(mu, x, Ymu, Ymup1);
      return GSL_ERROR_SELECT_2(stat_J, stat_Y);
    }
    else if(x < 1000.0) {
      double P, Q;
      double J_ratio;
      double J_sgn;
      const int stat_CF1 = gsl_sf_bessel_J_CF1(mu, x, &J_ratio, &J_sgn);
      const int stat_CF2 = gsl_sf_bessel_JY_steed_CF2(mu, x, &P, &Q);
      double Jprime_J_ratio = mu/x - J_ratio;
      double gamma = (P - Jprime_J_ratio)/Q;
      Jmu->val = J_sgn * sqrt(2.0/(M_PI*x) / (Q + gamma*(P-Jprime_J_ratio)));
      Jmu->err = 4.0 * GSL_DBL_EPSILON * fabs(Jmu->val);
      Jmup1->val = J_ratio * Jmu->val;
      Jmup1->err = fabs(J_ratio) * Jmu->err;
      Ymu->val = gamma * Jmu->val;
      Ymu->err = fabs(gamma) * Jmu->err;
      Ymup1->val = Ymu->val * (mu/x - P - Q/gamma);
      Ymup1->err = Ymu->err * fabs(mu/x - P - Q/gamma) + 4.0*GSL_DBL_EPSILON*fabs(Ymup1->val);
      return GSL_ERROR_SELECT_2(stat_CF1, stat_CF2);
    }
    else {
      /* Use asymptotics for large argument.
       */
      const int stat_J0 = gsl_sf_bessel_Jnu_asympx_e(mu,     x, Jmu);
      const int stat_J1 = gsl_sf_bessel_Jnu_asympx_e(mu+1.0, x, Jmup1);
      const int stat_Y0 = gsl_sf_bessel_Ynu_asympx_e(mu,     x, Ymu);
      const int stat_Y1 = gsl_sf_bessel_Ynu_asympx_e(mu+1.0, x, Ymup1);
      stat_J = GSL_ERROR_SELECT_2(stat_J0, stat_J1);
      stat_Y = GSL_ERROR_SELECT_2(stat_Y0, stat_Y1);
      return GSL_ERROR_SELECT_2(stat_J, stat_Y);
    }
  }
}

int
gsl_sf_bessel_J_CF1(const double nu, const double x,
                    double * ratio, double * sgn)
{
  const double RECUR_BIG = GSL_SQRT_DBL_MAX;
  const int maxiter = 10000;
  int n = 1;
  double Anm2 = 1.0;
  double Bnm2 = 0.0;
  double Anm1 = 0.0;
  double Bnm1 = 1.0;
  double a1 = x/(2.0*(nu+1.0));
  double An = Anm1 + a1*Anm2;
  double Bn = Bnm1 + a1*Bnm2;
  double an;
  double fn = An/Bn;
  double dn = a1;
  double s  = 1.0;

  while(n < maxiter) {
    double old_fn;
    double del;
    n++;
    Anm2 = Anm1;
    Bnm2 = Bnm1;
    Anm1 = An;
    Bnm1 = Bn;
    an = -x*x/(4.0*(nu+n-1.0)*(nu+n));
    An = Anm1 + an*Anm2;
    Bn = Bnm1 + an*Bnm2;

    if(fabs(An) > RECUR_BIG || fabs(Bn) > RECUR_BIG) {
      An /= RECUR_BIG;
      Bn /= RECUR_BIG;
      Anm1 /= RECUR_BIG;
      Bnm1 /= RECUR_BIG;
      Anm2 /= RECUR_BIG;
      Bnm2 /= RECUR_BIG;
    }

    old_fn = fn;
    fn = An/Bn;
    del = old_fn/fn;

    dn = 1.0 / (2.0*(nu+n)/x - dn);
    if(dn < 0.0) s = -s;

    if(fabs(del - 1.0) < 2.0*GSL_DBL_EPSILON) break;
  }

  *ratio = fn;
  *sgn   = s;

  if(n >= maxiter)
    GSL_ERROR ("error", GSL_EMAXITER);
  else
    return GSL_SUCCESS;
}

/* Evaluate the continued fraction CF1 for J_{nu+1}/J_nu
 * using Gautschi (Euler) equivalent series.
 * This exhibits an annoying problem because the
 * a_k are not positive definite (in fact they are all negative).
 * There are cases when rho_k blows up. Example: nu=1,x=4.
 */
#if 0
int
gsl_sf_bessel_J_CF1_ser(const double nu, const double x,
                        double * ratio, double * sgn)
{
  const int maxk = 20000;
  double tk   = 1.0;
  double sum  = 1.0;
  double rhok = 0.0;
  double dk = 0.0;
  double s  = 1.0;
  int k;

  for(k=1; k<maxk; k++) {
    double ak = -0.25 * (x/(nu+k)) * x/(nu+k+1.0);
    rhok = -ak*(1.0 + rhok)/(1.0 + ak*(1.0 + rhok));
    tk  *= rhok;
    sum += tk;

    dk = 1.0 / (2.0/x - (nu+k-1.0)/(nu+k) * dk);
    if(dk < 0.0) s = -s;

    if(fabs(tk/sum) < GSL_DBL_EPSILON) break;
  }

  *ratio = x/(2.0*(nu+1.0)) * sum;
  *sgn   = s;

  if(k == maxk)
    GSL_ERROR ("error", GSL_EMAXITER);
  else
    return GSL_SUCCESS;
}
#endif

/* Evaluate the continued fraction CF1 for I_{nu+1}/I_nu
 * using Gautschi (Euler) equivalent series.
 */
int
gsl_sf_bessel_I_CF1_ser(const double nu, const double x, double * ratio)
{
  const int maxk = 20000;
  double tk   = 1.0;
  double sum  = 1.0;
  double rhok = 0.0;
  int k;

  for(k=1; k<maxk; k++) {
    double ak = 0.25 * (x/(nu+k)) * x/(nu+k+1.0);
    rhok = -ak*(1.0 + rhok)/(1.0 + ak*(1.0 + rhok));
    tk  *= rhok;
    sum += tk;
    if(fabs(tk/sum) < GSL_DBL_EPSILON) break;
  }

  *ratio = x/(2.0*(nu+1.0)) * sum;

  if(k == maxk)
    GSL_ERROR ("error", GSL_EMAXITER);
  else
    return GSL_SUCCESS;
}

int
gsl_sf_bessel_JY_steed_CF2(const double nu, const double x,
                           double * P, double * Q)
{
  const int max_iter = 10000;
  const double SMALL = 1.0e-100;

  int i = 1;

  double x_inv = 1.0/x;
  double a = 0.25 - nu*nu;
  double p = -0.5*x_inv;
  double q = 1.0;
  double br = 2.0*x;
  double bi = 2.0;
  double fact = a*x_inv/(p*p + q*q);
  double cr = br + q*fact;
  double ci = bi + p*fact;
  double den = br*br + bi*bi;
  double dr = br/den;
  double di = -bi/den;
  double dlr = cr*dr - ci*di;
  double dli = cr*di + ci*dr;
  double temp = p*dlr - q*dli;
  q = p*dli + q*dlr;
  p = temp;
  for (i=2; i<=max_iter; i++) {
    a  += 2*(i-1);
    bi += 2.0;
    dr = a*dr + br;
    di = a*di + bi;
    if(fabs(dr)+fabs(di) < SMALL) dr = SMALL;
    fact = a/(cr*cr+ci*ci);
    cr = br + cr*fact;
    ci = bi - ci*fact;
    if(fabs(cr)+fabs(ci) < SMALL) cr = SMALL;
    den = dr*dr + di*di;
    dr /= den;
    di /= -den;
    dlr = cr*dr - ci*di;
    dli = cr*di + ci*dr;
    temp = p*dlr - q*dli;
    q = p*dli + q*dlr;
    p = temp;
    if(fabs(dlr-1.0)+fabs(dli) < GSL_DBL_EPSILON) break;
  }

  *P = p;
  *Q = q;

  if(i == max_iter)
    GSL_ERROR ("error", GSL_EMAXITER);
  else
    return GSL_SUCCESS;
}

/* Evaluate continued fraction CF2, using Thompson-Barnett-Temme method,
 * to obtain values of exp(x)*K_nu and exp(x)*K_{nu+1}.
 *
 * This is unstable for small x; x > 2 is a good cutoff.
 * Also requires |nu| < 1/2.
 */
int
gsl_sf_bessel_K_scaled_steed_temme_CF2(const double nu, const double x,
                                       double * K_nu, double * K_nup1,
                                       double * Kp_nu)
{
  const int maxiter = 10000;

  int i = 1;
  double bi = 2.0*(1.0 + x);
  double di = 1.0/bi;
  double delhi = di;
  double hi    = di;

  double qi   = 0.0;
  double qip1 = 1.0;

  double ai = -(0.25 - nu*nu);
  double a1 = ai;
  double ci = -ai;
  double Qi = -ai;

  double s = 1.0 + Qi*delhi;

  for(i=2; i<=maxiter; i++) {
    double dels;
    double tmp;
    ai -= 2.0*(i-1);
    ci  = -ai*ci/i;
    tmp  = (qi - bi*qip1)/ai;
    qi   = qip1;
    qip1 = tmp;
    Qi += ci*qip1;
    bi += 2.0;
    di  = 1.0/(bi + ai*di);
    delhi = (bi*di - 1.0) * delhi;
    hi += delhi;
    dels = Qi*delhi;
    s += dels;
    if(fabs(dels/s) < GSL_DBL_EPSILON) break;
  }

  hi *= -a1;

  *K_nu   = sqrt(M_PI/(2.0*x)) / s;
  *K_nup1 = *K_nu * (nu + x + 0.5 - hi)/x;
  *Kp_nu  = - *K_nup1 + nu/x * *K_nu;
  if(i == maxiter)
    GSL_ERROR ("error", GSL_EMAXITER);
  else
    return GSL_SUCCESS;
}

int gsl_sf_bessel_cos_pi4_e(double y, double eps, gsl_sf_result * result)
{
  const double sy = sin(y);
  const double cy = cos(y);
  const double s = sy + cy;
  const double d = sy - cy;
  const double abs_sum = fabs(cy) + fabs(sy);
  double seps;
  double ceps;
  if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
    const double e2 = eps*eps;
    seps = eps * (1.0 - e2/6.0 * (1.0 - e2/20.0));
    ceps = 1.0 - e2/2.0 * (1.0 - e2/12.0);
  }
  else {
    seps = sin(eps);
    ceps = cos(eps);
  }
  result->val = (ceps * s - seps * d)/ M_SQRT2;
  result->err = 2.0 * GSL_DBL_EPSILON * (fabs(ceps) + fabs(seps)) * abs_sum / M_SQRT2;

  /* Try to account for error in evaluation of sin(y), cos(y).
   * This is a little sticky because we don't really know
   * how the library routines are doing their argument reduction.
   * However, we will make a reasonable guess.
   * FIXME ?
   */
  if(y > 1.0/GSL_DBL_EPSILON) {
    result->err *= 0.5 * y;
  }
  else if(y > 1.0/GSL_SQRT_DBL_EPSILON) {
    result->err *= 256.0 * y * GSL_SQRT_DBL_EPSILON;
  }

  return GSL_SUCCESS;
}

int gsl_sf_bessel_sin_pi4_e(double y, double eps, gsl_sf_result * result)
{
  const double sy = sin(y);
  const double cy = cos(y);
  const double s = sy + cy;
  const double d = sy - cy;
  const double abs_sum = fabs(cy) + fabs(sy);
  double seps;
  double ceps;
  if(fabs(eps) < GSL_ROOT5_DBL_EPSILON) {
    const double e2 = eps*eps;
    seps = eps * (1.0 - e2/6.0 * (1.0 - e2/20.0));
    ceps = 1.0 - e2/2.0 * (1.0 - e2/12.0);
  }
  else {
    seps = sin(eps);
    ceps = cos(eps);
  }
  result->val = (ceps * d + seps * s)/ M_SQRT2;
  result->err = 2.0 * GSL_DBL_EPSILON * (fabs(ceps) + fabs(seps)) * abs_sum / M_SQRT2;

  /* Try to account for error in evaluation of sin(y), cos(y).
   * See above.
   * FIXME ?
   */
  if(y > 1.0/GSL_DBL_EPSILON) {
    result->err *= 0.5 * y;
  }
  else if(y > 1.0/GSL_SQRT_DBL_EPSILON) {
    result->err *= 256.0 * y * GSL_SQRT_DBL_EPSILON;
  }

  return GSL_SUCCESS;
}

/************************************************************************
 *                                                                      *
  Asymptotic approximations 8.11.5, 8.12.5, and 8.42.7 from
  G.N.Watson, A Treatise on the Theory of Bessel Functions,
  2nd Edition (Cambridge University Press, 1944).
  Higher terms in expansion for x near l given by
  Airey in Phil. Mag. 31, 520 (1916).

  This approximation is accurate to near 0.1% at the boundaries
  between the asymptotic regions; well away from the boundaries
  the accuracy is better than 10^{-5}.
 *                                                                      *
 ************************************************************************/
#if 0
double besselJ_meissel(double nu, double x)
{
  double beta = pow(nu, 0.325);
  double result;

  /* Fitted matching points.   */
  double llimit = 1.1 * beta;
  double ulimit = 1.3 * beta;

  double nu2 = nu * nu;

  if (nu < 5. && x < 1.)
    {
      /* Small argument and order. Use a Taylor expansion. */
      int k;
      double xo2 = 0.5 * x;
      double gamfactor = pow(nu,nu) * exp(-nu) * sqrt(nu * 2. * M_PI)
	* (1. + 1./(12.*nu) + 1./(288.*nu*nu));
      double prefactor = pow(xo2, nu) / gamfactor;
      double C[5];

      C[0] = 1.;
      C[1] = -C[0] / (nu+1.);
      C[2] = -C[1] / (2.*(nu+2.));
      C[3] = -C[2] / (3.*(nu+3.));
      C[4] = -C[3] / (4.*(nu+4.));

      result = 0.;
      for(k=0; k<5; k++)
	result += C[k] * pow(xo2, 2.*k);

      result *= prefactor;
    }
  else if(x < nu - llimit)
    {
      /* Small x region: x << l.    */
      double z = x / nu;
      double z2 = z*z;
      double rtomz2 = sqrt(1.-z2);
      double omz2_2 = (1.-z2)*(1.-z2);

      /* Calculate Meissel exponent. */
      double term1 = 1./(24.*nu) * ((2.+3.*z2)/((1.-z2)*rtomz2) -2.);
      double term2 = - z2*(4. + z2)/(16.*nu2*(1.-z2)*omz2_2);
      double V_nu = term1 + term2;

      /* Calculate the harmless prefactor. */
      double sterlingsum = 1. + 1./(12.*nu) + 1./(288*nu2);
      double harmless = 1. / (sqrt(rtomz2*2.*M_PI*nu) * sterlingsum);

      /* Calculate the logarithm of the nu dependent prefactor. */
      double ln_nupre = rtomz2 + log(z) - log(1. + rtomz2);

      result = harmless * exp(nu*ln_nupre - V_nu);
    }
  else if(x < nu + ulimit)
    {
      /* Intermediate region 1: x near nu. */
      double eps = 1.-nu/x;
      double eps_x = eps * x;
      double eps_x_2 = eps_x * eps_x;
      double xo6 = x/6.;
      double B[6];
      static double gam[6] = {2.67894, 1.35412, 1., 0.89298, 0.902745, 1.};
      static double sf[6] = {0.866025, 0.866025, 0., -0.866025, -0.866025, 0.};

      /* Some terms are identically zero, because sf[] can be zero.
       * Some terms do not appear in the result.
       */
      B[0] = 1.;
      B[1] = eps_x;
      /* B[2] = 0.5 * eps_x_2 - 1./20.; */
      B[3] = eps_x * (eps_x_2/6. - 1./15.);
      B[4] = eps_x_2 * (eps_x_2 - 1.)/24. + 1./280.;
      /* B[5] = eps_x * (eps_x_2*(0.5*eps_x_2 - 1.)/60. + 43./8400.); */

      result  = B[0] * gam[0] * sf[0] / pow(xo6, 1./3.);
      result += B[1] * gam[1] * sf[1] / pow(xo6, 2./3.);
      result += B[3] * gam[3] * sf[3] / pow(xo6, 4./3.);
      result += B[4] * gam[4] * sf[4] / pow(xo6, 5./3.);

      result /= (3.*M_PI);
    }
  else
    {
      /* Region of very large argument. Use expansion
       * for x>>l, and we need not be very exacting.
       */
      double secb = x/nu;
      double sec2b= secb*secb;

      double cotb = 1./sqrt(sec2b-1.);      /* cotb=cot(beta) */

      double beta = acos(nu/x);
      double trigarg = nu/cotb - nu*beta - 0.25 * M_PI;

      double cot3b = cotb * cotb * cotb;
      double cot6b = cot3b * cot3b;

      double sum1, sum2, expterm, prefactor, trigcos;

      sum1  = 2.0 + 3.0 * sec2b;
      trigarg -= sum1 * cot3b / (24.0 * nu);

      trigcos = cos(trigarg);

      sum2 = 4.0 + sec2b;
      expterm = sum2 * sec2b * cot6b / (16.0 * nu2);

      expterm = exp(-expterm);
      prefactor = sqrt(2. * cotb / (nu * M_PI));

      result = prefactor * expterm * trigcos;
    }

  return  result;
}
#endif


#ifndef LIBGAD
#define LIBGAD
#ifndef NOPOT
#define POTENTIAL
#endif
#include <stdio.h>
#include <math.h>

#ifndef NOGSL
#ifndef GSL
#define GSL
#endif
#endif

#ifdef GSL
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_eigen.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_linalg.h>
#endif

#define	MIN(a, b)   ((a)<(b)?(a):(b))
#define	MAX(a, b)   ((a)>(b)?(a):(b))
#define ABS(a) ((a) >= 0 ? (a) : -(a))
#define SQR(x) ((x)*(x))
#define OMEGA_M 0.26
#define OMEGA_L 0.74
#define HUB 0.72
#define GRAV 6.6742e-11
#define MSUN 1.989e30
#define KPC 3.085678e19  //meters
#define sec_per_yr 3.155e7
#define GALAGE(a) galage(a, OMEGA_M, OMEGA_L, HUB)
#define TIMEDIFF(a,b) timediff(a, b, OMEGA_M, OMEGA_L, HUB)

#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif

#ifdef LONGIDS
typedef unsigned long long IDtype;
#else
typedef unsigned int IDtype;
#endif

typedef float fltarr[3];
struct header
  {
    int npart[6];
    double massarr[6];
    double time;
    double redsh;
    int flg_sfr;
    int flg_fdbck;
    int nall[6];
    int flag_cool;
    int numfiles;
    double boxsize;
    double omega0;
    double omegal;
    double hubparam;
    int flg_age;
    int flg_mtl;
    int bytesleft[22];
};

typedef struct sphdata
{
  float u;
  float rho;
  float nelec;
  float nh;
  float hsml;
  float sfr;
#ifdef WINDS
  float dtime;
  float metals[4];
  float tmax;
  float n_spawn;
#endif //WINDS
#ifdef METALS
  float temp;
#endif
} sphdata;

#if defined(WINDS) || defined(METALS)
typedef struct stardata
{
#ifdef WINDS
  float metals[4];
  float tmax;
  float n_spawn;
#else
  int let;
  float initialmass;
#endif
} stardata;
#endif //WINDS || METALS

typedef struct gadpart
{
  fltarr pos;
#ifndef NOVEL
  fltarr vel;
#endif //NOVEL
  float mass;
  IDtype id;
  short type;
#ifndef NOGAS
  sphdata *sph;
  float stellarage;
#endif
#ifdef POTENTIAL
  float pot;
#endif

#if defined(WINDS) || defined(METALS)
  stardata *sd;
#endif //WINDS

#ifdef METALS
  float* metals;
#endif
} gadpart;

typedef struct gadpart_dist
{
  gadpart part;
  double dist;
} gadpart_dist;

int cmp_id (const void *first, const void *second);
int cmp_pointer_id(const void *a, const void *b);
int cmp_type (const void *first, const void *second);
int cmp_pos (const void *first, const void *second);
int cmp_x (const void *first, const void *second);
int cmp_y (const void *first, const void *second);
int cmp_z (const void *first, const void *second);
int cmp_dist (const void *first, const void *second);
int cmp_int (const void *first, const void *second);
int cmp_float (const void *first, const void *second);
unsigned int readgadget(char *filename, struct header *h, fltarr **p, fltarr **v, int **n, float **m);
unsigned int readgadget_part(char *filename, struct header *h,struct gadpart **part);
#ifdef LONGIDS
unsigned int writegadget(char *filename, struct header h, fltarr *p, fltarr *v, long *n, float *m);
#else
unsigned int writegadget(char *filename, struct header h, fltarr *p, fltarr *v, int *n, float *m);
#endif
unsigned int writegadget_part(char *filename, struct header h, struct gadpart *part);
unsigned int readgadget_novel(char *filename, struct header *h, fltarr **p, int **n, float **m);
unsigned int readgadget_sph(char *filename, struct header *h, fltarr **p, fltarr **v, int **n, float **m, float **u, float **rho, float **d1, float **d2, float **d3, float **d4 , float **sa);
int convertunits(struct header *head, struct gadpart *part, double convert_mass, double convert_distance);
double distance(fltarr a, fltarr b);
double distance_nopb(fltarr a, fltarr b);
double distbox(fltarr a, fltarr min, fltarr max);
double distbox_nopb(fltarr a, fltarr min, fltarr max);
void cpygadpart(gadpart * to, gadpart * from);
int gadsearch(gadpart_dist *data, double toFind, int start, int end);
double nfwfit(double *par, gadpart_dist *part, int cnt, double rv, double soft, double *rcs);
double densproffit(double *par, gadpart_dist *part, int cnt, double re, double soft, double *rcs, int type);
void calcdist(gadpart_dist *gd, int cnt, float *center);
void simplecenter(gadpart *part, int cnt, double* cm, int use);
void pcenter(gadpart_dist *part, int cnt, double, float*, int);
void findcenter(gadpart *part, int cnt, double maxdist, int use);
void simplecm(gadpart ** part, int cnt, float * cm);
double r200(gadpart_dist* pd, int cnt, double denscontrast, struct header h, int *vcnt, double *mvir);
double xoffset(gadpart_dist* pd, int cnt, float rvir, float* center);
#ifndef NOGAS
double temperature(const gadpart part);
#endif //NOGAS
void dummyfunction();
double galage(double z, double omegam, double omegal, double h);
double timediff(double z1, double z2, double omegam, double omegal, double h);
double a2z(double a);
double z2a(double z);
double angle(fltarr a, fltarr b);
double radvel(fltarr vel, fltarr rad);
struct header cphead(struct header head, gadpart* part, int cnt);

#ifdef GSL
void rotatepart(gadpart *part, int numpart, const gsl_matrix *rotmat);
void xrotate(double angle, gadpart *part, int numpart);
void yrotate(double angle, gadpart *part, int numpart);
void zrotate(double angle, gadpart *part, int numpart);
void rotategalaxy(gadpart *part, int numpart, double rad, int use, double *res, gsl_matrix **rotation);
#endif

#endif //LIBGAD


#ifndef __MATH_GSL_MATRIX__
#define __MATH_GSL_MATRIX__

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_cblas.h>

class GslMatrixItem {
 public:
  GslMatrixItem(gsl_matrix* ptr, size_t index1, size_t index2) :
    ptr_(ptr),
    index1_(index1),
    index2_(index2) { }

  operator const double() {
    return gsl_matrix_get(ptr_, index1_, index2_);
  }

  double operator =(const double v) {
    gsl_matrix_set(ptr_, index1_, index2_, v);
    return v;
  }

  double operator +=(const double v) {
    double old_v = gsl_matrix_get(ptr_, index1_, index2_);
    gsl_matrix_set(ptr_, index1_, index2_, v + old_v);
    return v + old_v;
  }
 private:
  gsl_matrix* ptr_;
  size_t index1_;
  size_t index2_;
};

class GslMatrixBase {
 public:
  GslMatrixBase& operator=(const double v) {
    if (v == 0.0) {
      SetZero();
    } else {
      SetAll(v);
    }
    return *this;
  }

  GslMatrixItem operator()(const size_t index1, const size_t index2) const {
    assert(ptr_ != NULL);
    return GslMatrixItem(ptr_, index1, index2);
  }

  void SetZero() {
    assert(ptr_ != NULL);
    gsl_matrix_set_zero(ptr_);
  }

  void SetAll(const double v) {
    assert(ptr_ != NULL);
    gsl_matrix_set_all(ptr_, v);
  }

  void Reset(gsl_matrix* val) {
    if(ptr_ != NULL) {
      gsl_matrix_free(ptr_);
    }
    ptr_ = val;
  }

  int Fprintf(FILE* stream, const char* format) const {
    assert(ptr_ != NULL);
    return gsl_matrix_fprintf(stream, ptr_, format);
  }

  int Fscanf(FILE* stream) {
    assert(ptr_ != NULL);
    return gsl_matrix_fscanf(stream, ptr_);
  }

  void Set(const int i, const int j, double val) {
    gsl_matrix_set(ptr_, i, j, val);
  }

  /*
    double operator()(const int nCol, const int nRow) {
    return gsl_matrix_get(ptr_, nCol, nRow);
    }
  */

  int size1() const {
    return ptr_->size1;
  }

  int size2() const {
    return ptr_->size2;
  }

  double Trace() const {
    double val = 0;
    assert(ptr_ != NULL);
    assert(ptr_->size1 == ptr_->size2);
    for (size_t ii = 0; ii < ptr_->size1; ++ii) {
      val += gsl_matrix_get(ptr_, ii, ii);
    }
    return val;
  }

  double Sum() const {
    double val = 0;
    assert(ptr_ != NULL);
    for (size_t ii = 0; ii < ptr_->size1; ++ii) {
      for (size_t jj = 0; jj < ptr_->size2; ++jj) {
	val += gsl_matrix_get(ptr_, ii, jj);
      }
    }
    return val;
  }

  /*
   * Apply the transpose of this matrix to a vector x and store the result.

   int TransMul(const GslVector& x, GslVector& res, double scale = 0.0) {
   return gsl_blas_dgemv(CblasTrans, 1.0, ptr_, x.ptr(), scale, res.ptr());
   }

   int Mul(const GslVector& x, GslVector& res, double scale = 0.0) {
   return gsl_blas_dgemv(CblasNoTrans, 1.0, ptr_, x.ptr(), scale, res.ptr());
   }
  */

  const gsl_matrix* ptr() const { return ptr_; }
  gsl_matrix* mutable_ptr() { return ptr_; }

 protected:
  GslMatrixBase() : ptr_(NULL) {
  }
  gsl_matrix* ptr_;

 private:
  GslMatrixBase(const GslMatrixBase&) { }
};

class GslMatrix : public GslMatrixBase {
 public:
  GslMatrix(const size_t size1, const size_t size2) : GslMatrixBase() {
    Allocate(size1, size2);
  }

  void Allocate(const size_t size1, const size_t size2) {
    assert(ptr_ == NULL);
    ptr_ = gsl_matrix_alloc(size1, size2);
  }

  GslMatrix() : GslMatrixBase() {
  }

  GslMatrix(gsl_matrix* val) : GslMatrixBase() {
    ptr_ = val;
  }

  ~GslMatrix() {
    if(ptr_ != NULL) {
      gsl_matrix_free(ptr_);
    }
  }

  GslMatrixBase& operator=(const double v) {
    GslMatrixBase::operator=(v);
    return *this;
  }
 private:
  GslMatrix(const GslMatrix&) { }
};

class GslSubmatrix : public GslMatrixBase {
 public:
 GslSubmatrix(GslMatrixBase& matrix, size_t k1, size_t k2, size_t n1, size_t n2) :
  view_(gsl_matrix_submatrix(matrix.mutable_ptr(), k1, k2, n1, n2)) {
     ptr_ = &view_.matrix;
  }

 GslSubmatrix(gsl_matrix* matrix, size_t k1, size_t k2, size_t n1, size_t n2) :
  view_(gsl_matrix_submatrix(matrix, k1, k2, n1, n2)) {
     ptr_ = &view_.matrix;
  }

  GslMatrixBase& operator=(const double v) {
    GslMatrixBase::operator=(v);
    return *this;
  }
 private:
  gsl_matrix_view view_;
  GslSubmatrix(const GslSubmatrix&) { }
};

#endif  // __MATH_GSL_MATRIX__


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "compearth.h"
/*
#ifdef COMPEARTH_USE_MKL
#include <mkl_cblas.h>
#else
#include <cblas.h>
#endif
*/

/*!
 * @brief Converts a moment tensor, M, from input system defined by i1in
 *        to moment tensor, Mout, to output system defind by i2in.
 *
 * @param[in] nmt      Number of moment tensors.
 * @param[in] i1in     Coordinate system for M: \n
 *                       = CE_USE (1) -> up, south, east \n
 *                       = CE_NED (2) -> north, east, down \n
 *                       = CE_NWU (3) -> north west, up \n
 *                       = CE_ENU (4) -> east, north, up \n
 *                       = CE_SEU (5) -> south, east, up \n
 * @param[in] i2in     Coordinate system for Mout: \n
 *                       = CE_USE (1) -> up, south, east \n
 *                       = CE_NED (2) -> north, east, down \n
 *                       = CE_NWU (3) -> north west, up \n
 *                       = CE_ENU (4) -> east, north, up \n
 *                       = CE_SEU (5) -> south, east, up \n
 * @param[in] M        Input moment tensor in system i1in.  This is an
 *                     an array of dimension [6 x nmt].
 *                     The C indices {0,1,2,3,4,5} correspond to matrix
 *                     indices: {11, 22, 33, 12, 13, 23}.
 *
 * @param[out] Mout    Corresponding moment tensor now in system i2in.
 *                     This is an array of dimension [6 x nmt].
 *                     the C indices {0,1,2,3,4,5} correspond to matrix
 *                     indices: {11, 22, 33, 12, 13, 23}
 *
 * @result 0 indicates success.
 *
 * @date 2016 - Ben Baker converted Carl Tape's convert_MT.m to C
 *
 * @copyright MIT
 *
 */
int compearth_convertMT(const int nmt,
                        const enum compearthCoordSystem_enum i1in,
                        const enum compearthCoordSystem_enum i2in,
                        const double *__restrict__ M,
                        double *__restrict__ Mout)
{
    int i, i1, i2;
    // Check the inputs to avoid seg faults
    if (nmt < 1 || M == NULL || Mout == NULL)
    {
        if (nmt < 1){fprintf(stderr, "%s: No moment tensors\n", __func__);}
        if (M == NULL){fprintf(stderr, "%s: Error M is NULL\n", __func__);}
        if (Mout == NULL)
        {
            fprintf(stderr, "%s: Error Mout is NULL\n", __func__);
        }
        return -1;
    }
    for (i=0; i<6*nmt; i++){Mout[i] = 0.0;}
    // Quick checks
    i1 = (int) i1in;
    i2 = (int) i2in;
    if (i1 < 1 || i1 > 5)
    {
        fprintf(stderr, "%s: Error unknown input coordinate system %d\n",
                __func__, i1);
        return -1;
    }
    if (i2 < 1 || i2 > 5)
    {
        fprintf(stderr, "%s: Error unkonwn output coordinate system %d\n",
                __func__, i2);
        return -1;
    }
    // Base case
    if (i1 == i2)
    {
        memcpy(Mout, M, (size_t) nmt*6*sizeof(double));
        //cblas_dcopy(6*nmt, M, 1, Mout, 1);
        return 0;
    }
    // Convert
    if (i1 == 1)
    {
        // up-south-east (GCMT) to north-east-down (AkiRichards)
        // (AR, 1980, p. 118)
        if (i2 == 2)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1]; //  tt -> xx
                Mout[6*i+1] = M[6*i+2]; //  pp -> yy
                Mout[6*i+2] = M[6*i+0]; //  rr -> zz
                Mout[6*i+3] =-M[6*i+5]; // -tp -> xy
                Mout[6*i+4] = M[6*i+3]; //  rt -> xz
                Mout[6*i+5] =-M[6*i+4]; // -rp -> yz
            }
       }
       // up-south-east (GCMT) to north-west-up
       else if (i2 == 3)
       {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+2];
                Mout[6*i+2] = M[6*i+0];
                Mout[6*i+3] = M[6*i+5];
                Mout[6*i+4] =-M[6*i+3];
                Mout[6*i+5] =-M[6*i+4];
            }
       }
       // up-south-east (GCMT) to east-north-up
       else if (i2 == 4)
       {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+2];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+0];
                Mout[6*i+3] =-M[6*i+5];
                Mout[6*i+4] = M[6*i+4];
                Mout[6*i+5] =-M[6*i+3];
            }
       }
       // up-south-east (GCMT) to south-east-up
       else if (i2 == 5)
       {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+2];
                Mout[6*i+2] = M[6*i+0];
                Mout[6*i+3] = M[6*i+5];
                Mout[6*i+4] = M[6*i+3];
                Mout[6*i+5] = M[6*i+4];
            }
        }
    }
    else if (i1 == 2)
    {
        // north-east-down (AkiRichards) to up-south-east (GCMT)
        // (AR, 1980, p. 118)
        if (i2 == 1)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+2]; //  zz -> rr
                Mout[6*i+1] = M[6*i+0]; //  xx -> tt
                Mout[6*i+2] = M[6*i+1]; //  yy -> pp
                Mout[6*i+3] = M[6*i+4]; //  xz -> rt
                Mout[6*i+4] =-M[6*i+5]; // -yz -> rp
                Mout[6*i+5] =-M[6*i+3]; // -xy -> tp
            }
        }
        // north-east-down (AkiRichards) to north-west-up
        else if (i2 == 3)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] =-M[6*i+4];
                Mout[6*i+5] = M[6*i+5];
            }
        }
        // north-east-down (AkiRichards) to east-north-up
        else if (i2 == 4)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] = M[6*i+3];
                Mout[6*i+4] =-M[6*i+5];
                Mout[6*i+5] =-M[6*i+4];
            }
        }
        // north-east-down (AkiRichards) to south-east-up
        else if (i2 == 5)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] = M[6*i+4];
                Mout[6*i+5] =-M[6*i+5];
            }
        }
    }
    else if (i1 == 3)
    {
        // north-west-up to up-south-east (GCMT)
        if (i2 == 1)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+2];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+1];
                Mout[6*i+3] =-M[6*i+4];
                Mout[6*i+4] =-M[6*i+5];
                Mout[6*i+5] = M[6*i+3];
            }
        }
        // north-west-up to north-east-down (AkiRichards)
        else if (i2 == 2)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] =-M[6*i+4];
                Mout[6*i+5] = M[6*i+5];
            }
        }
        // north-west-up to east-north-up
        else if (i2 == 4)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] =-M[6*i+5];
                Mout[6*i+5] = M[6*i+4];
            }
        }
        // north-west-up to south-east-up
        else if (i2 == 5)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] = M[6*i+3];
                Mout[6*i+4] =-M[6*i+4];
                Mout[6*i+5] =-M[6*i+5];
            }
        }
    }
    else if (i1 == 4)
    {
        // east-north-up to up-south-east (GCMT)
        if (i2 == 1)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+2];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+0];
                Mout[6*i+3] =-M[6*i+5];
                Mout[6*i+4] = M[6*i+4];
                Mout[6*i+5] =-M[6*i+3];
            }
        }
        // east-north-up to north-east-down (AkiRichards)
        else if (i2 == 2)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] = M[6*i+3];
                Mout[6*i+4] =-M[6*i+5];
                Mout[6*i+5] =-M[6*i+4];
            }
        }
        // east-north-up to north-west-up
        else if (i2 == 3)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] = M[6*i+5];
                Mout[6*i+5] =-M[6*i+4];
            }
        }
        // east-north-up to south-east-up
        else if (i2 == 5)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] =-M[6*i+5];
                Mout[6*i+5] = M[6*i+4];
            }
        }
    }
    else if (i1 == 5)
    {
        // south-east-up to up-south-east (GCMT)
        if (i2 == 1)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+2];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+1];
                Mout[6*i+3] = M[6*i+4];
                Mout[6*i+4] = M[6*i+5];
                Mout[6*i+5] = M[6*i+3];
            }
        }
        // south-east-up to north-east-down (AkiRichards)
        else if (i2 == 2)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] = M[6*i+4];
                Mout[6*i+5] =-M[6*i+5];
            }
        }
        // south-east-up to north-west-up
        else if (i2 == 3)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+0];
                Mout[6*i+1] = M[6*i+1];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] = M[6*i+3];
                Mout[6*i+4] =-M[6*i+4];
                Mout[6*i+5] =-M[6*i+5];
            }
        }
        // south-east-up to east-north-up
        else if (i2 == 4)
        {
            for (i=0; i<nmt; i++)
            {
                Mout[6*i+0] = M[6*i+1];
                Mout[6*i+1] = M[6*i+0];
                Mout[6*i+2] = M[6*i+2];
                Mout[6*i+3] =-M[6*i+3];
                Mout[6*i+4] = M[6*i+5];
                Mout[6*i+5] =-M[6*i+4];
            }
        }
    }
    return 0;
}


/* eigen/nonsymmv.c
 *
 * Copyright (C) 2006 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 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 <math.h>

#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_eigen.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_vector_complex.h>
#include <gsl/gsl_matrix.h>

/*
 * This module computes the eigenvalues and eigenvectors of a real
 * nonsymmetric matrix.
 *
 * This file contains routines based on original code from LAPACK
 * which is distributed under the modified BSD license. The LAPACK
 * routines used are DTREVC and DLALN2.
 */

#define GSL_NONSYMMV_SMLNUM (2.0 * GSL_DBL_MIN)
#define GSL_NONSYMMV_BIGNUM ((1.0 - GSL_DBL_EPSILON) / GSL_NONSYMMV_SMLNUM)

static void nonsymmv_get_right_eigenvectors(gsl_matrix *T, gsl_matrix *Z,
                                            gsl_vector_complex *eval,
                                            gsl_matrix_complex *evec,
                                            gsl_eigen_nonsymmv_workspace *w);
static inline void nonsymmv_solve_equation(gsl_matrix *A, double z,
                                           gsl_vector *b, gsl_vector *x,
                                           double *s, double *xnorm,
                                           double smin);
static inline void nonsymmv_solve_equation_z(gsl_matrix *A, gsl_complex *z,
                                             gsl_vector_complex *b,
                                             gsl_vector_complex *x,
                                             double *s, double *xnorm,
                                             double smin);
static void nonsymmv_normalize_eigenvectors(gsl_vector_complex *eval,
                                            gsl_matrix_complex *evec);

/*
gsl_eigen_nonsymmv_alloc()

Allocate a workspace for solving the nonsymmetric eigenvalue problem.
The size of this workspace is O(5n).

Inputs: n - size of matrices

Return: pointer to workspace
*/

gsl_eigen_nonsymmv_workspace *
gsl_eigen_nonsymmv_alloc(const size_t n)
{
  gsl_eigen_nonsymmv_workspace *w;

  if (n == 0)
    {
      GSL_ERROR_NULL ("matrix dimension must be positive integer",
                      GSL_EINVAL);
    }

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

  if (w == 0)
    {
      GSL_ERROR_NULL ("failed to allocate space for workspace", GSL_ENOMEM);
    }

  w->size = n;
  w->Z = NULL;
  w->nonsymm_workspace_p = gsl_eigen_nonsymm_alloc(n);

  if (w->nonsymm_workspace_p == 0)
    {
      GSL_ERROR_NULL ("failed to allocate space for nonsymm workspace", GSL_ENOMEM);
    }

  /*
   * set parameters to compute the full Schur form T and balance
   * the matrices
   */
  gsl_eigen_nonsymm_params(1, 1, w->nonsymm_workspace_p);

  w->work = gsl_vector_alloc(n);
  w->work2 = gsl_vector_alloc(n);
  w->work3 = gsl_vector_alloc(n);
  if (w->work == 0 || w->work2 == 0 || w->work3 == 0)
    {
      GSL_ERROR_NULL ("failed to allocate space for nonsymmv additional workspace", GSL_ENOMEM);
    }

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

/*
gsl_eigen_nonsymmv_free()
  Free workspace w
*/

void
gsl_eigen_nonsymmv_free (gsl_eigen_nonsymmv_workspace * w)
{
  gsl_eigen_nonsymm_free(w->nonsymm_workspace_p);
  gsl_vector_free(w->work);
  gsl_vector_free(w->work2);
  gsl_vector_free(w->work3);

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

/*
gsl_eigen_nonsymmv()

Solve the nonsymmetric eigensystem problem

A x = \lambda x

for the eigenvalues \lambda and right eigenvectors x

Inputs: A    - general real matrix
        eval - where to store eigenvalues
        evec - where to store eigenvectors
        w    - workspace

Return: success or error
*/

int
gsl_eigen_nonsymmv (gsl_matrix * A, gsl_vector_complex * eval,
                    gsl_matrix_complex * evec,
                    gsl_eigen_nonsymmv_workspace * w)
{
  const size_t N = A->size1;

  /* check matrix and vector sizes */

  if (N != A->size2)
    {
      GSL_ERROR ("matrix must be square to compute eigenvalues", GSL_ENOTSQR);
    }
  else if (eval->size != N)
    {
      GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
    }
  else if (evec->size1 != evec->size2)
    {
      GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
    }
  else if (evec->size1 != N)
    {
      GSL_ERROR ("eigenvector matrix has wrong size", GSL_EBADLEN);
    }
  else
    {
      int s;
      gsl_matrix Z;

      /*
       * We need a place to store the Schur vectors, so we will
       * treat evec as a real matrix and store them in the left
       * half - the factor of 2 in the tda corresponds to the
       * complex multiplicity
       */
      Z.size1 = N;
      Z.size2 = N;
      Z.tda = 2 * N;
      Z.data = evec->data;
      Z.block = 0;
      Z.owner = 0;

      /* compute eigenvalues, Schur form, and Schur vectors */
      s = gsl_eigen_nonsymm_Z(A, eval, &Z, w->nonsymm_workspace_p);

      if (w->Z)
        {
          /*
           * save the Schur vectors in user supplied matrix, since
           * they will be destroyed when computing eigenvectors
           */
          gsl_matrix_memcpy(w->Z, &Z);
        }

      /* only compute eigenvectors if we found all eigenvalues */
      if (s == GSL_SUCCESS)
        {
          /* compute eigenvectors */
          nonsymmv_get_right_eigenvectors(A, &Z, eval, evec, w);

          /* normalize so that Euclidean norm is 1 */
          nonsymmv_normalize_eigenvectors(eval, evec);
        }

      return s;
    }
} /* gsl_eigen_nonsymmv() */

/*
gsl_eigen_nonsymmv_Z()
  Compute eigenvalues and eigenvectors of a real nonsymmetric matrix
and also save the Schur vectors. See comments in gsl_eigen_nonsymm_Z
for more information.

Inputs: A    - real nonsymmetric matrix
        eval - where to store eigenvalues
        evec - where to store eigenvectors
        Z    - where to store Schur vectors
        w    - nonsymmv workspace

Return: success or error
*/

int
gsl_eigen_nonsymmv_Z (gsl_matrix * A, gsl_vector_complex * eval,
                      gsl_matrix_complex * evec, gsl_matrix * Z,
                      gsl_eigen_nonsymmv_workspace * w)
{
  /* check matrix and vector sizes */

  if (A->size1 != A->size2)
    {
      GSL_ERROR ("matrix must be square to compute eigenvalues/eigenvectors", GSL_ENOTSQR);
    }
  else if (eval->size != A->size1)
    {
      GSL_ERROR ("eigenvalue vector must match matrix size", GSL_EBADLEN);
    }
  else if (evec->size1 != evec->size2)
    {
      GSL_ERROR ("eigenvector matrix must be square", GSL_ENOTSQR);
    }
  else if (evec->size1 != A->size1)
    {
      GSL_ERROR ("eigenvector matrix has wrong size", GSL_EBADLEN);
    }
  else if ((Z->size1 != Z->size2) || (Z->size1 != A->size1))
    {
      GSL_ERROR ("Z matrix has wrong dimensions", GSL_EBADLEN);
    }
  else
    {
      int s;

      w->Z = Z;

      s = gsl_eigen_nonsymmv(A, eval, evec, w);

      w->Z = NULL;

      return s;
    }
} /* gsl_eigen_nonsymmv_Z() */

/********************************************
 *           INTERNAL ROUTINES              *
 ********************************************/

/*
nonsymmv_get_right_eigenvectors()
  Compute the right eigenvectors of the Schur form T and then
backtransform them using the Schur vectors to get right eigenvectors of
the original matrix.

Inputs: T    - Schur form
        Z    - Schur vectors
        eval - where to store eigenvalues (to ensure that the
               correct eigenvalue is stored in the same position
               as the eigenvectors)
        evec - where to store eigenvectors
        w    - nonsymmv workspace

Return: none

Notes: 1) based on LAPACK routine DTREVC - the algorithm used is
          backsubstitution on the upper quasi triangular system T
          followed by backtransformation by Z to get vectors of the
          original matrix.

       2) The Schur vectors in Z are destroyed and replaced with
          eigenvectors stored with the same storage scheme as DTREVC.
          The eigenvectors are also stored in 'evec'

       3) The matrix T is unchanged on output

       4) Each eigenvector is normalized so that the element of
          largest magnitude has magnitude 1; here the magnitude of
          a complex number (x,y) is taken to be |x| + |y|
*/

static void
nonsymmv_get_right_eigenvectors(gsl_matrix *T, gsl_matrix *Z,
                                gsl_vector_complex *eval,
                                gsl_matrix_complex *evec,
                                gsl_eigen_nonsymmv_workspace *w)
{
  const size_t N = T->size1;
  const double smlnum = GSL_DBL_MIN * N / GSL_DBL_EPSILON;
  const double bignum = (1.0 - GSL_DBL_EPSILON) / smlnum;
  int i;              /* looping */
  size_t iu,          /* looping */
         ju,
         ii;
  gsl_complex lambda; /* current eigenvalue */
  double lambda_re,   /* Re(lambda) */
         lambda_im;   /* Im(lambda) */
  gsl_matrix_view Tv, /* temporary views */
                  Zv;
  gsl_vector_view y,  /* temporary views */
                  y2,
                  ev,
                  ev2;
  double dat[4],      /* scratch arrays */
         dat_X[4];
  double scale;       /* scale factor */
  double xnorm;       /* |X| */
  gsl_vector_complex_view ecol, /* column of evec */
                          ecol2;
  int complex_pair;   /* complex eigenvalue pair? */
  double smin;

  /*
   * Compute 1-norm of each column of upper triangular part of T
   * to control overflow in triangular solver
   */

  gsl_vector_set(w->work3, 0, 0.0);
  for (ju = 1; ju < N; ++ju)
    {
      gsl_vector_set(w->work3, ju, 0.0);
      for (iu = 0; iu < ju; ++iu)
        {
          gsl_vector_set(w->work3, ju,
                         gsl_vector_get(w->work3, ju) +
                         fabs(gsl_matrix_get(T, iu, ju)));
        }
    }

  for (i = (int) N - 1; i >= 0; --i)
    {
      iu = (size_t) i;

      /* get current eigenvalue and store it in lambda */
      lambda_re = gsl_matrix_get(T, iu, iu);

      if (iu != 0 && gsl_matrix_get(T, iu, iu - 1) != 0.0)
        {
          lambda_im = sqrt(fabs(gsl_matrix_get(T, iu, iu - 1))) *
                      sqrt(fabs(gsl_matrix_get(T, iu - 1, iu)));
        }
      else
        {
          lambda_im = 0.0;
        }

      GSL_SET_COMPLEX(&lambda, lambda_re, lambda_im);

      smin = GSL_MAX(GSL_DBL_EPSILON * (fabs(lambda_re) + fabs(lambda_im)),
                     smlnum);
      smin = GSL_MAX(smin, GSL_NONSYMMV_SMLNUM);

      if (lambda_im == 0.0)
        {
          int k, l;
          gsl_vector_view bv, xv;

          /* real eigenvector */

          /*
           * The ordering of eigenvalues in 'eval' is arbitrary and
           * does not necessarily follow the Schur form T, so store
           * lambda in the right slot in eval to ensure it corresponds
           * to the eigenvector we are about to compute
           */
          gsl_vector_complex_set(eval, iu, lambda);

          /*
           * We need to solve the system:
           *
           * (T(1:iu-1, 1:iu-1) - lambda*I)*X = -T(1:iu-1,iu)
           */

          /* construct right hand side */
          for (k = 0; k < i; ++k)
            {
              gsl_vector_set(w->work,
                             (size_t) k,
                             -gsl_matrix_get(T, (size_t) k, iu));
            }

          gsl_vector_set(w->work, iu, 1.0);

          for (l = i - 1; l >= 0; --l)
            {
              size_t lu = (size_t) l;

              if (lu == 0)
                complex_pair = 0;
              else
                complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;

              if (!complex_pair)
                {
                  double x;

                  /*
                   * 1-by-1 diagonal block - solve the system:
                   *
                   * (T_{ll} - lambda)*x = -T_{l(iu)}
                   */

                  Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
                  bv = gsl_vector_view_array(dat, 1);
                  gsl_vector_set(&bv.vector, 0,
                                 gsl_vector_get(w->work, lu));
                  xv = gsl_vector_view_array(dat_X, 1);

                  nonsymmv_solve_equation(&Tv.matrix,
                                          lambda_re,
                                          &bv.vector,
                                          &xv.vector,
                                          &scale,
                                          &xnorm,
                                          smin);

                  /* scale x to avoid overflow */
                  x = gsl_vector_get(&xv.vector, 0);
                  if (xnorm > 1.0)
                    {
                      if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
                        {
                          x /= xnorm;
                          scale /= xnorm;
                        }
                    }

                  if (scale != 1.0)
                    {
                      gsl_vector_view wv;

                      wv = gsl_vector_subvector(w->work, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                    }

                  gsl_vector_set(w->work, lu, x);

                  if (lu > 0)
                    {
                      gsl_vector_view v1, v2;

                      /* update right hand side */

                      v1 = gsl_matrix_column(T, lu);
                      v1 = gsl_vector_subvector(&v1.vector, 0, lu);

                      v2 = gsl_vector_subvector(w->work, 0, lu);

                      gsl_blas_daxpy(-x, &v1.vector, &v2.vector);
                    } /* if (l > 0) */
                } /* if (!complex_pair) */
              else
                {
                  double x11, x21;

                  /*
                   * 2-by-2 diagonal block
                   */

                  Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
                  bv = gsl_vector_view_array(dat, 2);
                  gsl_vector_set(&bv.vector, 0,
                                 gsl_vector_get(w->work, lu - 1));
                  gsl_vector_set(&bv.vector, 1,
                                 gsl_vector_get(w->work, lu));
                  xv = gsl_vector_view_array(dat_X, 2);

                  nonsymmv_solve_equation(&Tv.matrix,
                                          lambda_re,
                                          &bv.vector,
                                          &xv.vector,
                                          &scale,
                                          &xnorm,
                                          smin);

                  /* scale X(1,1) and X(2,1) to avoid overflow */
                  x11 = gsl_vector_get(&xv.vector, 0);
                  x21 = gsl_vector_get(&xv.vector, 1);

                  if (xnorm > 1.0)
                    {
                      double beta;

                      beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
                                     gsl_vector_get(w->work3, lu));
                      if (beta > bignum / xnorm)
                        {
                          x11 /= xnorm;
                          x21 /= xnorm;
                          scale /= xnorm;
                        }
                    }

                  /* scale if necessary */
                  if (scale != 1.0)
                    {
                      gsl_vector_view wv;

                      wv = gsl_vector_subvector(w->work, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                    }

                  gsl_vector_set(w->work, lu - 1, x11);
                  gsl_vector_set(w->work, lu, x21);

                  /* update right hand side */
                  if (lu > 1)
                    {
                      gsl_vector_view v1, v2;

                      v1 = gsl_matrix_column(T, lu - 1);
                      v1 = gsl_vector_subvector(&v1.vector, 0, lu - 1);
                      v2 = gsl_vector_subvector(w->work, 0, lu - 1);
                      gsl_blas_daxpy(-x11, &v1.vector, &v2.vector);

                      v1 = gsl_matrix_column(T, lu);
                      v1 = gsl_vector_subvector(&v1.vector, 0, lu - 1);
                      gsl_blas_daxpy(-x21, &v1.vector, &v2.vector);
                    }

                  --l;
                } /* if (complex_pair) */
            } /* for (l = i - 1; l >= 0; --l) */

          /*
           * At this point, w->work is an eigenvector of the
           * Schur form T. To get an eigenvector of the original
           * matrix, we multiply on the left by Z, the matrix of
           * Schur vectors
           */

          ecol = gsl_matrix_complex_column(evec, iu);
          y = gsl_matrix_column(Z, iu);

          if (iu > 0)
            {
              gsl_vector_view x;

              Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu);

              x = gsl_vector_subvector(w->work, 0, iu);

              /* compute Z * w->work and store it in Z(:,iu) */
              gsl_blas_dgemv(CblasNoTrans,
                             1.0,
                             &Zv.matrix,
                             &x.vector,
                             gsl_vector_get(w->work, iu),
                             &y.vector);
            } /* if (iu > 0) */

          /* store eigenvector into evec */

          ev = gsl_vector_complex_real(&ecol.vector);
          ev2 = gsl_vector_complex_imag(&ecol.vector);

          scale = 0.0;
          for (ii = 0; ii < N; ++ii)
            {
              double a = gsl_vector_get(&y.vector, ii);

              /* store real part of eigenvector */
              gsl_vector_set(&ev.vector, ii, a);

              /* set imaginary part to 0 */
              gsl_vector_set(&ev2.vector, ii, 0.0);

              if (fabs(a) > scale)
                scale = fabs(a);
            }

          if (scale != 0.0)
            scale = 1.0 / scale;

          /* scale by magnitude of largest element */
          gsl_blas_dscal(scale, &ev.vector);
        } /* if (GSL_IMAG(lambda) == 0.0) */
      else
        {
          gsl_vector_complex_view bv, xv;
          size_t k;
          int l;
          gsl_complex lambda2;

          /* complex eigenvector */

          /*
           * Store the complex conjugate eigenvalues in the right
           * slots in eval
           */
          GSL_SET_REAL(&lambda2, GSL_REAL(lambda));
          GSL_SET_IMAG(&lambda2, -GSL_IMAG(lambda));
          gsl_vector_complex_set(eval, iu - 1, lambda);
          gsl_vector_complex_set(eval, iu, lambda2);

          /*
           * First solve:
           *
           * [ T(i:i+1,i:i+1) - lambda*I ] * X = 0
           */

          if (fabs(gsl_matrix_get(T, iu - 1, iu)) >=
              fabs(gsl_matrix_get(T, iu, iu - 1)))
            {
              gsl_vector_set(w->work, iu - 1, 1.0);
              gsl_vector_set(w->work2, iu,
                             lambda_im / gsl_matrix_get(T, iu - 1, iu));
            }
          else
            {
              gsl_vector_set(w->work, iu - 1,
                             -lambda_im / gsl_matrix_get(T, iu, iu - 1));
              gsl_vector_set(w->work2, iu, 1.0);
            }
          gsl_vector_set(w->work, iu, 0.0);
          gsl_vector_set(w->work2, iu - 1, 0.0);

          /* construct right hand side */
          for (k = 0; k < iu - 1; ++k)
            {
              gsl_vector_set(w->work, k,
                             -gsl_vector_get(w->work, iu - 1) *
                             gsl_matrix_get(T, k, iu - 1));
              gsl_vector_set(w->work2, k,
                             -gsl_vector_get(w->work2, iu) *
                             gsl_matrix_get(T, k, iu));
            }

          /*
           * We must solve the upper quasi-triangular system:
           *
           * [ T(1:i-2,1:i-2) - lambda*I ] * X = s*(work + i*work2)
           */

          for (l = i - 2; l >= 0; --l)
            {
              size_t lu = (size_t) l;

              if (lu == 0)
                complex_pair = 0;
              else
                complex_pair = gsl_matrix_get(T, lu, lu - 1) != 0.0;

              if (!complex_pair)
                {
                  gsl_complex bval;
                  gsl_complex x;

                  /*
                   * 1-by-1 diagonal block - solve the system:
                   *
                   * (T_{ll} - lambda)*x = work + i*work2
                   */

                  Tv = gsl_matrix_submatrix(T, lu, lu, 1, 1);
                  bv = gsl_vector_complex_view_array(dat, 1);
                  xv = gsl_vector_complex_view_array(dat_X, 1);

                  GSL_SET_COMPLEX(&bval,
                                  gsl_vector_get(w->work, lu),
                                  gsl_vector_get(w->work2, lu));
                  gsl_vector_complex_set(&bv.vector, 0, bval);

                  nonsymmv_solve_equation_z(&Tv.matrix,
                                            &lambda,
                                            &bv.vector,
                                            &xv.vector,
                                            &scale,
                                            &xnorm,
                                            smin);

                  if (xnorm > 1.0)
                    {
                      if (gsl_vector_get(w->work3, lu) > bignum / xnorm)
                        {
                          gsl_blas_zdscal(1.0/xnorm, &xv.vector);
                          scale /= xnorm;
                        }
                    }

                  /* scale if necessary */
                  if (scale != 1.0)
                    {
                      gsl_vector_view wv;

                      wv = gsl_vector_subvector(w->work, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                      wv = gsl_vector_subvector(w->work2, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                    }

                  x = gsl_vector_complex_get(&xv.vector, 0);
                  gsl_vector_set(w->work, lu, GSL_REAL(x));
                  gsl_vector_set(w->work2, lu, GSL_IMAG(x));

                  /* update the right hand side */
                  if (lu > 0)
                    {
                      gsl_vector_view v1, v2;

                      v1 = gsl_matrix_column(T, lu);
                      v1 = gsl_vector_subvector(&v1.vector, 0, lu);
                      v2 = gsl_vector_subvector(w->work, 0, lu);
                      gsl_blas_daxpy(-GSL_REAL(x), &v1.vector, &v2.vector);

                      v2 = gsl_vector_subvector(w->work2, 0, lu);
                      gsl_blas_daxpy(-GSL_IMAG(x), &v1.vector, &v2.vector);
                    } /* if (lu > 0) */
                } /* if (!complex_pair) */
              else
                {
                  gsl_complex b1, b2, x1, x2;

                  /*
                   * 2-by-2 diagonal block - solve the system
                   */

                  Tv = gsl_matrix_submatrix(T, lu - 1, lu - 1, 2, 2);
                  bv = gsl_vector_complex_view_array(dat, 2);
                  xv = gsl_vector_complex_view_array(dat_X, 2);

                  GSL_SET_COMPLEX(&b1,
                                  gsl_vector_get(w->work, lu - 1),
                                  gsl_vector_get(w->work2, lu - 1));
                  GSL_SET_COMPLEX(&b2,
                                  gsl_vector_get(w->work, lu),
                                  gsl_vector_get(w->work2, lu));
                  gsl_vector_complex_set(&bv.vector, 0, b1);
                  gsl_vector_complex_set(&bv.vector, 1, b2);

                  nonsymmv_solve_equation_z(&Tv.matrix,
                                            &lambda,
                                            &bv.vector,
                                            &xv.vector,
                                            &scale,
                                            &xnorm,
                                            smin);

                  x1 = gsl_vector_complex_get(&xv.vector, 0);
                  x2 = gsl_vector_complex_get(&xv.vector, 1);

                  if (xnorm > 1.0)
                    {
                      double beta;

                      beta = GSL_MAX(gsl_vector_get(w->work3, lu - 1),
                                     gsl_vector_get(w->work3, lu));
                      if (beta > bignum / xnorm)
                        {
                          gsl_blas_zdscal(1.0/xnorm, &xv.vector);
                          scale /= xnorm;
                        }
                    }

                  /* scale if necessary */
                  if (scale != 1.0)
                    {
                      gsl_vector_view wv;

                      wv = gsl_vector_subvector(w->work, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                      wv = gsl_vector_subvector(w->work2, 0, iu + 1);
                      gsl_blas_dscal(scale, &wv.vector);
                    }
                  gsl_vector_set(w->work, lu - 1, GSL_REAL(x1));
                  gsl_vector_set(w->work, lu, GSL_REAL(x2));
                  gsl_vector_set(w->work2, lu - 1, GSL_IMAG(x1));
                  gsl_vector_set(w->work2, lu, GSL_IMAG(x2));

                  /* update right hand side */
                  if (lu > 1)
                    {
                      gsl_vector_view v1, v2, v3, v4;

                      v1 = gsl_matrix_column(T, lu - 1);
                      v1 = gsl_vector_subvector(&v1.vector, 0, lu - 1);
                      v4 = gsl_matrix_column(T, lu);
                      v4 = gsl_vector_subvector(&v4.vector, 0, lu - 1);
                      v2 = gsl_vector_subvector(w->work, 0, lu - 1);
                      v3 = gsl_vector_subvector(w->work2, 0, lu - 1);

                      gsl_blas_daxpy(-GSL_REAL(x1), &v1.vector, &v2.vector);
                      gsl_blas_daxpy(-GSL_REAL(x2), &v4.vector, &v2.vector);
                      gsl_blas_daxpy(-GSL_IMAG(x1), &v1.vector, &v3.vector);
                      gsl_blas_daxpy(-GSL_IMAG(x2), &v4.vector, &v3.vector);
                    } /* if (lu > 1) */

                  --l;
                } /* if (complex_pair) */
            } /* for (l = i - 2; l >= 0; --l) */

          /*
           * At this point, work + i*work2 is an eigenvector
           * of T - backtransform to get an eigenvector of the
           * original matrix
           */

          y = gsl_matrix_column(Z, iu - 1);
          y2 = gsl_matrix_column(Z, iu);

          if (iu > 1)
            {
              gsl_vector_view x;

              /* compute real part of eigenvectors */

              Zv = gsl_matrix_submatrix(Z, 0, 0, N, iu - 1);
              x = gsl_vector_subvector(w->work, 0, iu - 1);

              gsl_blas_dgemv(CblasNoTrans,
                             1.0,
                             &Zv.matrix,
                             &x.vector,
                             gsl_vector_get(w->work, iu - 1),
                             &y.vector);

              /* now compute the imaginary part */
              x = gsl_vector_subvector(w->work2, 0, iu - 1);

              gsl_blas_dgemv(CblasNoTrans,
                             1.0,
                             &Zv.matrix,
                             &x.vector,
                             gsl_vector_get(w->work2, iu),
                             &y2.vector);
            }
          else
            {
              gsl_blas_dscal(gsl_vector_get(w->work, iu - 1), &y.vector);
              gsl_blas_dscal(gsl_vector_get(w->work2, iu), &y2.vector);
            }

          /*
           * Now store the eigenvectors into evec - the real parts
           * are Z(:,iu - 1) and the imaginary parts are
           * +/- Z(:,iu)
           */

          /* get views of the two eigenvector slots */
          ecol = gsl_matrix_complex_column(evec, iu - 1);
          ecol2 = gsl_matrix_complex_column(evec, iu);

          /*
           * save imaginary part first as it may get overwritten
           * when copying the real part due to our storage scheme
           * in Z/evec
           */
          ev = gsl_vector_complex_imag(&ecol.vector);
          ev2 = gsl_vector_complex_imag(&ecol2.vector);
          scale = 0.0;
          for (ii = 0; ii < N; ++ii)
            {
              double a = gsl_vector_get(&y2.vector, ii);

              scale = GSL_MAX(scale,
                              fabs(a) + fabs(gsl_vector_get(&y.vector, ii)));

              gsl_vector_set(&ev.vector, ii, a);
              gsl_vector_set(&ev2.vector, ii, -a);
            }

          /* now save the real part */
          ev = gsl_vector_complex_real(&ecol.vector);
          ev2 = gsl_vector_complex_real(&ecol2.vector);
          for (ii = 0; ii < N; ++ii)
            {
              double a = gsl_vector_get(&y.vector, ii);

              gsl_vector_set(&ev.vector, ii, a);
              gsl_vector_set(&ev2.vector, ii, a);
            }

          if (scale != 0.0)
            scale = 1.0 / scale;

          /* scale by largest element magnitude */

          gsl_blas_zdscal(scale, &ecol.vector);
          gsl_blas_zdscal(scale, &ecol2.vector);

          /*
           * decrement i since we took care of two eigenvalues at
           * the same time
           */
          --i;
        } /* if (GSL_IMAG(lambda) != 0.0) */
    } /* for (i = (int) N - 1; i >= 0; --i) */
} /* nonsymmv_get_right_eigenvectors() */

/*
nonsymmv_solve_equation()

  Solve the equation which comes up in the back substitution
when computing eigenvectors corresponding to real eigenvalues.
The equation that is solved is:

(A - z*I)*x = s*b

where

A is n-by-n with n = 1 or 2
b and x are n-by-1 real vectors
s is a scaling factor set by this function to prevent overflow in x

Inputs: A     - square matrix (n-by-n)
        z     - real scalar (eigenvalue)
        b     - right hand side vector
        x     - (output) where to store solution
        s     - (output) scale factor
        xnorm - (output) infinity norm of X
        smin  - lower bound on singular values of A - if A - z*I
                is less than this value, we'll use smin*I instead.
                This value should be a safe distance above underflow.

Notes: 1) A and b are not changed on output
       2) Based on lapack routine DLALN2
*/

static inline void
nonsymmv_solve_equation(gsl_matrix *A, double z, gsl_vector *b,
                        gsl_vector *x, double *s, double *xnorm,
                        double smin)
{
  size_t N = A->size1;
  double bnorm;
  double scale = 1.0;

  if (N == 1)
    {
      double c,     /* denominator */
             cnorm; /* |c| */

      /*
       * we have a 1-by-1 (real) scalar system to solve:
       *
       * (a - z)*x = b
       * with z real
       */

      /* c = a - z */
      c = gsl_matrix_get(A, 0, 0) - z;
      cnorm = fabs(c);

      if (cnorm < smin)
        {
          /* set c = smin*I */
          c = smin;
          cnorm = smin;
        }

      /* check scaling for x = b / c */
      bnorm = fabs(gsl_vector_get(b, 0));
      if (cnorm < 1.0 && bnorm > 1.0)
        {
          if (bnorm > GSL_NONSYMMV_BIGNUM*cnorm)
            scale = 1.0 / bnorm;
        }

      /* compute x */
      gsl_vector_set(x, 0, gsl_vector_get(b, 0) * scale / c);
      *xnorm = fabs(gsl_vector_get(x, 0));
    } /* if (N == 1) */
  else
    {
      double cr[2][2];
      double *crv;
      double cmax;
      size_t icmax, j;
      double bval1, bval2;
      double ur11, ur12, ur22, ur11r;
      double cr21, cr22;
      double lr21;
      double b1, b2, bbnd;
      double x1, x2;
      double temp;
      size_t ipivot[4][4] = { { 0, 1, 2, 3 },
                              { 1, 0, 3, 2 },
                              { 2, 3, 0, 1 },
                              { 3, 2, 1, 0 } };
      int rswap[4] = { 0, 1, 0, 1 };
      int zswap[4] = { 0, 0, 1, 1 };

      /*
       * we have a 2-by-2 real system to solve:
       *
       * [ A11 - z   A12   ] [ x1 ] = [ b1 ]
       * [   A21   A22 - z ] [ x2 ]   [ b2 ]
       *
       * (z real)
       */

      crv = (double *) cr;

      /*
       * compute the real part of C = A - z*I - use column ordering
       * here since porting from lapack
       */
      cr[0][0] = gsl_matrix_get(A, 0, 0) - z;
      cr[1][1] = gsl_matrix_get(A, 1, 1) - z;
      cr[0][1] = gsl_matrix_get(A, 1, 0);
      cr[1][0] = gsl_matrix_get(A, 0, 1);

      /* find the largest element in C */
      cmax = 0.0;
      icmax = 0;
      for (j = 0; j < 4; ++j)
        {
          if (fabs(crv[j]) > cmax)
            {
              cmax = fabs(crv[j]);
              icmax = j;
            }
        }

      bval1 = gsl_vector_get(b, 0);
      bval2 = gsl_vector_get(b, 1);

      /* if norm(C) < smin, use smin*I */

      if (cmax < smin)
        {
          bnorm = GSL_MAX(fabs(bval1), fabs(bval2));
          if (smin < 1.0 && bnorm > 1.0)
            {
              if (bnorm > GSL_NONSYMMV_BIGNUM*smin)
                scale = 1.0 / bnorm;
            }
          temp = scale / smin;
          gsl_vector_set(x, 0, temp * bval1);
          gsl_vector_set(x, 1, temp * bval2);
          *xnorm = temp * bnorm;
          *s = scale;
          return;
        }

      /* gaussian elimination with complete pivoting */
      ur11 = crv[icmax];
      cr21 = crv[ipivot[1][icmax]];
      ur12 = crv[ipivot[2][icmax]];
      cr22 = crv[ipivot[3][icmax]];
      ur11r = 1.0 / ur11;
      lr21 = ur11r * cr21;
      ur22 = cr22 - ur12 * lr21;

      /* if smaller pivot < smin, use smin */
      if (fabs(ur22) < smin)
        ur22 = smin;

      if (rswap[icmax])
        {
          b1 = bval2;
          b2 = bval1;
        }
      else
        {
          b1 = bval1;
          b2 = bval2;
        }

      b2 -= lr21 * b1;
      bbnd = GSL_MAX(fabs(b1 * (ur22 * ur11r)), fabs(b2));
      if (bbnd > 1.0 && fabs(ur22) < 1.0)
        {
          if (bbnd >= GSL_NONSYMMV_BIGNUM * fabs(ur22))
            scale = 1.0 / bbnd;
        }

      x2 = (b2 * scale) / ur22;
      x1 = (scale * b1) * ur11r - x2 * (ur11r * ur12);
      if (zswap[icmax])
        {
          gsl_vector_set(x, 0, x2);
          gsl_vector_set(x, 1, x1);
        }
      else
        {
          gsl_vector_set(x, 0, x1);
          gsl_vector_set(x, 1, x2);
        }

      *xnorm = GSL_MAX(fabs(x1), fabs(x2));

      /* further scaling if norm(A) norm(X) > overflow */
      if (*xnorm > 1.0 && cmax > 1.0)
        {
          if (*xnorm > GSL_NONSYMMV_BIGNUM / cmax)
            {
              temp = cmax / GSL_NONSYMMV_BIGNUM;
              gsl_blas_dscal(temp, x);
              *xnorm *= temp;
              scale *= temp;
            }
        }
    } /* if (N == 2) */

  *s = scale;
} /* nonsymmv_solve_equation() */

/*
nonsymmv_solve_equation_z()

  Solve the equation which comes up in the back substitution
when computing eigenvectors corresponding to complex eigenvalues.
The equation that is solved is:

(A - z*I)*x = s*b

where

A is n-by-n with n = 1 or 2
b and x are n-by-1 complex vectors
s is a scaling factor set by this function to prevent overflow in x

Inputs: A     - square matrix (n-by-n)
        z     - complex scalar (eigenvalue)
        b     - right hand side vector
        x     - (output) where to store solution
        s     - (output) scale factor
        xnorm - (output) infinity norm of X
        smin  - lower bound on singular values of A - if A - z*I
                is less than this value, we'll use smin*I instead.
                This value should be a safe distance above underflow.

Notes: 1) A and b are not changed on output
       2) Based on lapack routine DLALN2
*/

static inline void
nonsymmv_solve_equation_z(gsl_matrix *A, gsl_complex *z,
                          gsl_vector_complex *b, gsl_vector_complex *x,
                          double *s, double *xnorm, double smin)
{
  size_t N = A->size1;
  double scale = 1.0;
  double bnorm;

  if (N == 1)
    {
      double cr,    /* denominator */
             ci,
             cnorm; /* |c| */
      gsl_complex bval, c, xval, tmp;

      /*
       * we have a 1-by-1 (complex) scalar system to solve:
       *
       * (a - z)*x = b
       * (z is complex, a is real)
       */

      /* c = a - z */
      cr = gsl_matrix_get(A, 0, 0) - GSL_REAL(*z);
      ci = -GSL_IMAG(*z);
      cnorm = fabs(cr) + fabs(ci);

      if (cnorm < smin)
        {
          /* set c = smin*I */
          cr = smin;
          ci = 0.0;
          cnorm = smin;
        }

      /* check scaling for x = b / c */
      bval = gsl_vector_complex_get(b, 0);
      bnorm = fabs(GSL_REAL(bval)) + fabs(GSL_IMAG(bval));
      if (cnorm < 1.0 && bnorm > 1.0)
        {
          if (bnorm > GSL_NONSYMMV_BIGNUM*cnorm)
            scale = 1.0 / bnorm;
        }

      /* compute x */
      GSL_SET_COMPLEX(&tmp, scale*GSL_REAL(bval), scale*GSL_IMAG(bval));
      GSL_SET_COMPLEX(&c, cr, ci);
      xval = gsl_complex_div(tmp, c);

      gsl_vector_complex_set(x, 0, xval);

      *xnorm = fabs(GSL_REAL(xval)) + fabs(GSL_IMAG(xval));
    } /* if (N == 1) */
  else
    {
      double cr[2][2], ci[2][2];
      double *civ, *crv;
      double cmax;
      gsl_complex bval1, bval2;
      gsl_complex xval1, xval2;
      double xr1, xi1;
      size_t icmax;
      size_t j;
      double temp;
      double ur11, ur12, ur22, ui11, ui12, ui22, ur11r, ui11r;
      double ur12s, ui12s;
      double u22abs;
      double lr21, li21;
      double cr21, cr22, ci21, ci22;
      double br1, bi1, br2, bi2, bbnd;
      gsl_complex b1, b2;
      size_t ipivot[4][4] = { { 0, 1, 2, 3 },
                              { 1, 0, 3, 2 },
                              { 2, 3, 0, 1 },
                              { 3, 2, 1, 0 } };
      int rswap[4] = { 0, 1, 0, 1 };
      int zswap[4] = { 0, 0, 1, 1 };

      /*
       * complex 2-by-2 system:
       *
       * [ A11 - z   A12   ] [ X1 ] = [ B1 ]
       * [   A21   A22 - z ] [ X2 ]   [ B2 ]
       *
       * (z complex)
       *
       * where the X and B values are complex.
       */

      civ = (double *) ci;
      crv = (double *) cr;

      /*
       * compute the real part of C = A - z*I - use column ordering
       * here since porting from lapack
       */
      cr[0][0] = gsl_matrix_get(A, 0, 0) - GSL_REAL(*z);
      cr[1][1] = gsl_matrix_get(A, 1, 1) - GSL_REAL(*z);
      cr[0][1] = gsl_matrix_get(A, 1, 0);
      cr[1][0] = gsl_matrix_get(A, 0, 1);

      /* compute the imaginary part */
      ci[0][0] = -GSL_IMAG(*z);
      ci[0][1] = 0.0;
      ci[1][0] = 0.0;
      ci[1][1] = -GSL_IMAG(*z);

      cmax = 0.0;
      icmax = 0;

      for (j = 0; j < 4; ++j)
        {
          if (fabs(crv[j]) + fabs(civ[j]) > cmax)
            {
              cmax = fabs(crv[j]) + fabs(civ[j]);
              icmax = j;
            }
        }

      bval1 = gsl_vector_complex_get(b, 0);
      bval2 = gsl_vector_complex_get(b, 1);

      /* if norm(C) < smin, use smin*I */
      if (cmax < smin)
        {
          bnorm = GSL_MAX(fabs(GSL_REAL(bval1)) + fabs(GSL_IMAG(bval1)),
                          fabs(GSL_REAL(bval2)) + fabs(GSL_IMAG(bval2)));
          if (smin < 1.0 && bnorm > 1.0)
            {
              if (bnorm > GSL_NONSYMMV_BIGNUM*smin)
                scale = 1.0 / bnorm;
            }

          temp = scale / smin;
          xval1 = gsl_complex_mul_real(bval1, temp);
          xval2 = gsl_complex_mul_real(bval2, temp);
          gsl_vector_complex_set(x, 0, xval1);
          gsl_vector_complex_set(x, 1, xval2);
          *xnorm = temp * bnorm;
          *s = scale;
          return;
        }

      /* gaussian elimination with complete pivoting */
      ur11 = crv[icmax];
      ui11 = civ[icmax];
      cr21 = crv[ipivot[1][icmax]];
      ci21 = civ[ipivot[1][icmax]];
      ur12 = crv[ipivot[2][icmax]];
      ui12 = civ[ipivot[2][icmax]];
      cr22 = crv[ipivot[3][icmax]];
      ci22 = civ[ipivot[3][icmax]];

      if (icmax == 0 || icmax == 3)
        {
          /* off diagonals of pivoted C are real */
          if (fabs(ur11) > fabs(ui11))
            {
              temp = ui11 / ur11;
              ur11r = 1.0 / (ur11 * (1.0 + temp*temp));
              ui11r = -temp * ur11r;
            }
          else
            {
              temp = ur11 / ui11;
              ui11r = -1.0 / (ui11 * (1.0 + temp*temp));
              ur11r = -temp*ui11r;
            }
          lr21 = cr21 * ur11r;
          li21 = cr21 * ui11r;
          ur12s = ur12 * ur11r;
          ui12s = ur12 * ui11r;
          ur22 = cr22 - ur12 * lr21;
          ui22 = ci22 - ur12 * li21;
        }
      else
        {
          /* diagonals of pivoted C are real */
          ur11r = 1.0 / ur11;
          ui11r = 0.0;
          lr21 = cr21 * ur11r;
          li21 = ci21 * ur11r;
          ur12s = ur12 * ur11r;
          ui12s = ui12 * ur11r;
          ur22 = cr22 - ur12 * lr21 + ui12 * li21;
          ui22 = -ur12 * li21 - ui12 * lr21;
        }

      u22abs = fabs(ur22) + fabs(ui22);

      /* if smaller pivot < smin, use smin */
      if (u22abs < smin)
        {
          ur22 = smin;
          ui22 = 0.0;
        }

      if (rswap[icmax])
        {
          br2 = GSL_REAL(bval1);
          bi2 = GSL_IMAG(bval1);
          br1 = GSL_REAL(bval2);
          bi1 = GSL_IMAG(bval2);
        }
      else
        {
          br1 = GSL_REAL(bval1);
          bi1 = GSL_IMAG(bval1);
          br2 = GSL_REAL(bval2);
          bi2 = GSL_IMAG(bval2);
        }

      br2 += li21*bi1 - lr21*br1;
      bi2 -= li21*br1 + lr21*bi1;
      bbnd = GSL_MAX((fabs(br1) + fabs(bi1)) *
                     (u22abs * (fabs(ur11r) + fabs(ui11r))),
                     fabs(br2) + fabs(bi2));
      if (bbnd > 1.0 && u22abs < 1.0)
        {
          if (bbnd >= GSL_NONSYMMV_BIGNUM*u22abs)
            {
              scale = 1.0 / bbnd;
              br1 *= scale;
              bi1 *= scale;
              br2 *= scale;
              bi2 *= scale;
            }
        }

      GSL_SET_COMPLEX(&b1, br2, bi2);
      GSL_SET_COMPLEX(&b2, ur22, ui22);
      xval2 = gsl_complex_div(b1, b2);

      xr1 = ur11r*br1 - ui11r*bi1 - ur12s*GSL_REAL(xval2) + ui12s*GSL_IMAG(xval2);
      xi1 = ui11r*br1 + ur11r*bi1 - ui12s*GSL_REAL(xval2) - ur12s*GSL_IMAG(xval2);
      GSL_SET_COMPLEX(&xval1, xr1, xi1);

      if (zswap[icmax])
        {
          gsl_vector_complex_set(x, 0, xval2);
          gsl_vector_complex_set(x, 1, xval1);
        }
      else
        {
          gsl_vector_complex_set(x, 0, xval1);
          gsl_vector_complex_set(x, 1, xval2);
        }

      *xnorm = GSL_MAX(fabs(GSL_REAL(xval1)) + fabs(GSL_IMAG(xval1)),
                       fabs(GSL_REAL(xval2)) + fabs(GSL_IMAG(xval2)));

      /* further scaling if norm(A) norm(X) > overflow */
      if (*xnorm > 1.0 && cmax > 1.0)
        {
          if (*xnorm > GSL_NONSYMMV_BIGNUM / cmax)
            {
              temp = cmax / GSL_NONSYMMV_BIGNUM;
              gsl_blas_zdscal(temp, x);
              *xnorm *= temp;
              scale *= temp;
            }
        }
    } /* if (N == 2) */

  *s = scale;
} /* nonsymmv_solve_equation_z() */

/*
nonsymmv_normalize_eigenvectors()
  Normalize eigenvectors so that their Euclidean norm is 1

Inputs: eval - eigenvalues
        evec - eigenvectors
*/

static void
nonsymmv_normalize_eigenvectors(gsl_vector_complex *eval,
                                gsl_matrix_complex *evec)
{
  const size_t N = evec->size1;
  size_t i;     /* looping */
  gsl_complex ei;
  gsl_vector_complex_view vi;
  gsl_vector_view re, im;
  double scale; /* scaling factor */

  for (i = 0; i < N; ++i)
    {
      ei = gsl_vector_complex_get(eval, i);
      vi = gsl_matrix_complex_column(evec, i);

      re = gsl_vector_complex_real(&vi.vector);

      if (GSL_IMAG(ei) == 0.0)
        {
          scale = 1.0 / gsl_blas_dnrm2(&re.vector);
          gsl_blas_dscal(scale, &re.vector);
        }
      else if (GSL_IMAG(ei) > 0.0)
        {
          im = gsl_vector_complex_imag(&vi.vector);

          scale = 1.0 / gsl_hypot(gsl_blas_dnrm2(&re.vector),
                                  gsl_blas_dnrm2(&im.vector));
          gsl_blas_zdscal(scale, &vi.vector);

          vi = gsl_matrix_complex_column(evec, i + 1);
          gsl_blas_zdscal(scale, &vi.vector);
        }
    }
} /* nonsymmv_normalize_eigenvectors() */