/* Library libcerf:
 *   Compute complex error functions, based on a new implementation of
 *   Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
 *
 * File w_of_z.c:
 *   Implements Faddeeva's complex scaled error function,
 *      w(z) = exp(-z^2) * erfc(-i*z),
 *   nameless function (7.1.3) of Abramowitz&Stegun (1964),
 *   also known as the plasma dispersion function.
 *
 *   This implementation uses three different expansions:
 *   - Maclaurin series for |z| < 0.23..
 *   - Tilewise Taylor expansion for intermediate |z|,
 *       generated by software ttapp (https://jugit.fz-juelich.de/mlz/app/ttapp),
 *       cf Wuttke, "Code generation for computing an analytic function with near
 *          machine precision on square tiles, with application to the Faddeeva function",
 *       unpublished manuscript, available upon request.
 *   - Asymptotic expansion for |z| >= 7, summed by a real three-term recurrence
 *
 * Copyright:
 *   (C) 2012      Massachusetts Institute of Technology
 *   (C) 2013-2026 Forschungszentrum Jülich GmbH
 *
 * Licence:
 *   Permission is hereby granted, free of charge, to any person obtaining
 *   a copy of this software and associated documentation files (the
 *   "Software"), to deal in the Software without restriction, including
 *   without limitation the rights to use, copy, modify, merge, publish,
 *   distribute, sublicense, and/or sell copies of the Software, and to
 *   permit persons to whom the Software is furnished to do so, subject to
 *   the following conditions:
 *
 *   The above copyright notice and this permission notice shall be
 *   included in all copies or substantial portions of the Software.
 *
 *   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 *   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 *   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 *   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
 *   LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
 *   OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
 *   WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 *
 * Authors:
 *   Steven G. Johnson, Massachusetts Institute of Technology, 2012
 *   Joachim Wuttke, Forschungszentrum Jülich, 2013, 2025
 *
 * Website:
 *   https://jugit.fz-juelich.de/mlz/lib/cerf
 *
 * Revision history (see also ../CHANGELOG)
 *   - 2013, started as a wrapper around Faddeeva code by Johnson, using various algorithms
 *   - 2026, libcerf-3.6, for Im z > 0, 0.23<|z|<7 reimplemented via tilewise Taylor expansion
 *   - 2026, libcerf-3.7, asymptotic expansion summed by a real three-term recurrence
 *
 * Man page:
 *   w_of_z(3)
 */

/*
  Computes various error functions (erf, erfc, erfi, erfcx),
  including the Dawson integral, in the complex plane, based
  on algorithms for the computation of the Faddeeva function
  w(z) = exp(-z^2) * erfc(-i*z).
  Given w(z), the error functions are mostly straightforward
  to compute, except for certain regions where we have to
  switch to Taylor expansions to avoid cancellation errors
  [e.g. near the origin for erf(z)].

*/

#include "cerf.h"
#include "defs.h" // defines _cerf_cmplx, NaN, C, cexp, ...
#include "exp_z2.h"   // defines cerf_sqr_res, cerf_exp_mx2, cerf_cexp_mz2 (issue #32)
#include <assert.h>
#include <math.h>

#ifdef CERF_INTROSPECT
EXPORT int cerf_algorithm;
EXPORT int cerf_nofterms;
#endif

#include "auto_taylor_wofz_tiles.c" // -> static const int NTay; static const signed char Tiles[]
#include "auto_taylor_wofz_coeffs.c" // -> static const double TaylorCoeffs[]

/******************************************************************************/
/*  asymptotic expansion, summed by a real three-term recurrence              */
/******************************************************************************/

/* w(z) = i sum_{n<N} a_n / z^(2n+1) with a_n = Gamma(n+1/2)/pi, for Im z >= 0 and
   |z| >= 7; xs + i*ya is the evaluation point and s = xs^2 + ya^2.

   With eta = 1/z = mu - i*nu, the sum is i*eta*P(eta^2), P(t) = sum a_n t^n. Since
   the a_n are real and eta^2 is a root of the real quadratic t^2 - rho*t - sigma,
   with rho = 2 Re eta^2 and sigma = -|eta^2|^2, synthetic division of P by that
   quadratic (Knuth, TAOCP 2, sect. 4.6.4; the device of Goertzel and Clenshaw)
   evaluates P(eta^2) = gamma + beta_1 eta^2 through the real recurrence for the
   beta_n, and the prefactor i*eta is absorbed as well:
   Re w = nu (a_0 + g+), Im w = mu (a_0 + g-), g+- = (rho +- q) beta_1 + sigma beta_2.
   No complex product ever occurs, the reconstruction is free of cancellation, and
   Im w is strictly proportional to mu, so that its relative accuracy survives
   x -> 0. This is alternative C of Wuttke, "libcerf, complex error function and
   related functions reimplemented with relative accuracy guarantees" (in
   preparation), sect. "Asymptotic expansion", where the rounding error is bounded
   by 5.1 eps normwise and 5.4 eps componentwise at |z| = 7 (eps = 2^-53).

   The recurrence is stable because consecutive terms of the sum shrink by
   (n+1/2) q <= 43/98 < 1/2 for q = 1/s <= 1/49 and N <= 23, which keeps the
   beta_n within a factor 2.6 of the a_n; a smaller |z| or a larger N would need
   a new analysis. Two details of the evaluation order carry the error bound:
   q is formed as mu^2 + nu^2, consistent with the computed mu and nu, and not as
   1/s; and a_0 is added last, to the small correction g+-, so that only two
   roundings are incurred at the magnitude of the result. Written with plain
   multiplications and additions, so that a compiler contracts them into fused
   multiply-adds only where the target has the instruction; an explicit fma()
   would be a library call on the base x86-64 architecture. */

static _cerf_cmplx w_asymptotic(const double xs, const double ya, const double s, const int N)
{
    static const double a[23] = { // Gamma(n+1/2)/pi
        5.6418958354775628e-01, 2.8209479177387814e-01, 4.2314218766081724e-01, // n = 0..2
        1.0578554691520430e+00, 3.7024941420321507e+00, 1.6661223639144676e+01, // n = 3..5
        9.1636730015295726e+01, 5.9563874509942218e+02, 4.4672905882456671e+03, // n = 6..8
        3.7971970000088164e+04, 3.6073371500083758e+05, 3.7877040075087948e+06, // n = 9..11
        4.3558596086351141e+07, 5.4448245107938921e+08, 7.3505130895717545e+09, // n = 12..14
        1.0658243979879044e+11, 1.6520278168812520e+12, 2.7258458978540656e+13, // n = 15..17
        4.7702303212446150e+14, 8.8249260943025370e+15, 1.7208605883889949e+17, // n = 18..20
        3.5277642061974395e+18, 7.5846930433244938e+19, // n = 21..22
    };
    const double mu = xs / s;       // eta = 1/z = mu - i*nu
    const double nu = ya / s;
    const double U = mu * mu;
    const double V = nu * nu;
    const double q = U + V;         // |eta|^2, from U and V for consistency, not 1/s
    const double rho = 2 * (U - V); // 2 Re eta^2
    const double sigma = -(q * q);  // -|eta^2|^2

    // beta_n = a_n + sigma beta_{n+2} + rho beta_{n+1}, n = N-2..1, beta_{N-1} = a_{N-1}
    double b2 = 0;                  // beta_{n+2}
    double b1 = a[N - 1];           // beta_{n+1}
    for (int n = N - 2; n >= 1; --n) {
        const double b0 = a[n] + sigma * b2 + rho * b1;
        b2 = b1;
        b1 = b0;
    }
    // now b1 = beta_1, b2 = beta_2
    const double sb2 = sigma * b2;
    const double gp = sb2 + (rho + q) * b1;
    const double gm = sb2 + (rho - q) * b1;
    return C(nu * (a[0] + gp), mu * (a[0] + gm));
}

/******************************************************************************/
/*  Re w close to the real axis                                               */
/******************************************************************************/

/* Where |y| << |x|, Re w is smaller than |w| by a factor of about y/x. The
   tilewise Taylor approximation bounds the relative error of |w|, so that of
   Re w is amplified by x/y, up to 1e9 eps (issue #29). Here Re w is obtained
   from an expansion about the real axis instead, to fifth order in the small
   component; Im w, and with it |w|, is left to the tiles, which keeps their
   proven bound of 3 eps for the modulus.

   With w(z) = exp(-z^2) + 2i/sqrt(pi) F(z), where F is Dawson's integral,
   entire and real on the axis, the Taylor coefficients F^(n)(x)/n! are real.
   Scaling them as g_n = 2 F^(n)(x) / (n! sqrt(pi)), so that g_0 = Im w(x),
   only odd n enter Im F:
     Re w = exp(y^2-x^2) cos 2xy - sum_m (-1)^m g_{2m+1} y^{2m+1}.
   The m = 0 term is 2 y (x Im w(x) - 1/sqrt(pi)), which is the first-order
   formula that w_of_z uses for |y| < 1e-9|x|. Successive terms shrink by
   (y/x)^2, so five of them carry |y| < 1e-3|x| to below the last bit.

   The coefficients follow from F'(z) = 1 - 2 z F(z):
     g_{n+1} = (-2 x g_n - 2 g_{n-1}) / (n+1),
     g_0 = Im w(x),  g_1 = 2/sqrt(pi) - 2 x Im w(x).
   That recurrence loses about x^2 of relative accuracy per step. It does not
   matter: the term of index m contributes (y/x)^{2m} of the result, so the
   accuracy demanded of g_{2m+1} slackens by (x/y)^2 per step, faster than the
   recurrence loses it.

   Note that g_1 is the derivative of Im w. Formed as 2/sqrt(pi) - 2 x Im w(x)
   it would be a difference smaller than either term by 1/(2x^2), and would
   inherit 2x^2 times the relative error of im_w_of_x, some 200 eps at x = 7.
   It therefore comes from d_im_w_of_x, which has its own approximation
   (lib/dim_w_of_x.c) and is accurate to under 4 eps. */

static double re_w_near_axis(const double x, const double y)
{
    double g[11];
    g[0] = im_w_of_x(x);
    g[1] = d_im_w_of_x(x);
    for (int n = 1; n < 10; ++n)
        g[n + 1] = (-2. * x * g[n] - 2. * g[n - 1]) / (n + 1);

    // exp(y^2-x^2), with x*x carried as an unevaluated sum of two doubles: its
    // single rounding would otherwise cost eps x^2 / 2, that is 25 eps at x = 7
    const double xh = x * x;
    const double xl = cerf_sqr_res(x, xh);
    const double e2 = exp(y * y - xh) * (1. - xl);

    const double y2 = y * y;
    double so = 0.; // sum_m (-1)^{m+1} g_{2m+1} (y^2)^m
    for (int m = 4; m >= 0; --m)
        so = so * y2 + ((m % 2) ? g[2 * m + 1] : -g[2 * m + 1]);

    return e2 * cos(2. * x * y) + y * so;
}

/******************************************************************************/
/*  w_of_z, Faddeeva's scaled complex error function                          */
/******************************************************************************/

_cerf_cmplx w_of_z(_cerf_cmplx z) {

    const double x = creal(z);
    const double xa = fabs(x);
    const double y = cimag(z);
    const double ya = fabs(y);
    const double z2 = xa*xa + y*y;

// ------------------------------------------------------------------------------
// Case |y| << |x|
// ------------------------------------------------------------------------------

//   If |y| << |x|, we get |Re w| << |Im w|, which implies that an algorithm
//   can be very accurate in terms of the complex norm, with relative error
//   computed as |w - w_0| / |w_0|, and still Re w can be wrong by orders of
//   magnitude. Therefore this special case is treated beforehand.

//   We start from the real axis where w(x) = exp(-x^2) + i*im_w_of_x(x).
//   To compute w(x+iy) we assume that |y| is negligible when added to |x|.
//   We obtain Re w = exp(-x^2) - y d/dx Im w(x), the first two terms of the
//   expansion that re_w_near_axis carries further; the derivative comes from
//   d_im_w_of_x rather than from 2 (x Im w(x) - 1/sqrt(pi)), which would
//   cancel to relative size 1/(2 x^2). The exponential comes from exp_mx2,
//   which carries the exponent x*x as a double-word; a single rounding would
//   cost eps x^2 / 2 where that term dominates.

    if (ya < 1e-9 * xa) {
	const double wi = im_w_of_x(x);
        const double e2 = xa > 27. ? 0. : cerf_exp_mx2(xa);
	if (ya == 0)
	    return C(e2, wi); // also works for x=+-inf
	return C(e2 - y*d_im_w_of_x(x), wi - 2*x*y*e2);
    }

// ------------------------------------------------------------------------------
// Case |x| << |y|
// ------------------------------------------------------------------------------

//   If |x| << |y|, we get |Im w| << |Re w|, which implies that an algorithm
//   can be very accurate in terms of the complex norm, with relative error
//   computed as |w - w_0| / |w_0|, and still Im w can be wrong by orders of
//   magnitude. Therefore this special case is treated beforehand.

//   We start from the imaginary axis where w(iy) = erfcx(y).
//   To compute w(iy+x) we assume that |x| is negligible when added to |y|.
//   We obtain Im w = 2 x (1 / sqrt(pi) - y erfcx(y)) = -x erfcx'(y). The
//   derivative comes from d_erfcx rather than from that difference, which
//   cancels to relative size 1/(2 y^2); this is the mirror of the real-axis
//   case above (issue #31).

    if (xa < 1e-9 * ya) {
	const double wr = erfcx(y);
	if (xa == 0)
	    return C(wr, 0); // also works for y=+inf
	return C(wr, -x*d_erfcx(y));
    }

// ------------------------------------------------------------------------------
// Case |z| -> 0: Maclaurin series
// ------------------------------------------------------------------------------

    if (z2 < .053) {
        if (z2 < .00689) {
            if (z2 < 4e-7) {
                return ((((
                              + C(+5.0000000000000000e-01, 0) ) * z // z^4
                          + C(0, -7.5225277806367508e-01) ) * z // z^3
                         + C(-1.0000000000000000e+00, 0) ) * z // z^2
                        + C(0, +1.1283791670955126e+00) ) * z // z^1
                    + 1.;
            }

            return (((((((((((((
                                   + C(0, +5.3440090793734269e-04) ) * z // z^13
                               + C(+1.3888888888888889e-03, 0) ) * z // z^12
                              + C(0, -3.4736059015927274e-03) ) * z // z^11
                             + C(-8.3333333333333332e-03, 0) ) * z // z^10
                            + C(0, +1.9104832458760001e-02) ) * z // z^9
                           + C(+4.1666666666666664e-02, 0) ) * z // z^8
                          + C(0, -8.5971746064419999e-02) ) * z // z^7
                         + C(-1.6666666666666666e-01, 0) ) * z // z^6
                        + C(0, +3.0090111122547003e-01) ) * z // z^5
                       + C(+5.0000000000000000e-01, 0) ) * z // z^4
                      + C(0, -7.5225277806367508e-01) ) * z // z^3
                     + C(-1.0000000000000000e+00, 0) ) * z // z^2
                    + C(0, +1.1283791670955126e+00) ) * z // z^1
                + 1.;
        }

	return (((((((((((((((((((
				   + C(0, -8.8239572002038009e-07) ) * z // z^19
				 + C(-2.7557319223985893e-06, 0) ) * z // z^18
				+ C(0, +8.3827593401936105e-06) ) * z // z^17
			       + C(+2.4801587301587302e-05, 0) ) * z // z^16
			      + C(0, -7.1253454391645692e-05) ) * z // z^15
			     + C(-1.9841269841269841e-04, 0) ) * z // z^14
			    + C(0, +5.3440090793734269e-04) ) * z // z^13
			   + C(+1.3888888888888889e-03, 0) ) * z // z^12
			  + C(0, -3.4736059015927274e-03) ) * z // z^11
			 + C(-8.3333333333333332e-03, 0) ) * z // z^10
			+ C(0, +1.9104832458760001e-02) ) * z // z^9
		       + C(+4.1666666666666664e-02, 0) ) * z // z^8
		      + C(0, -8.5971746064419999e-02) ) * z // z^7
		     + C(-1.6666666666666666e-01, 0) ) * z // z^6
		    + C(0, +3.0090111122547003e-01) ) * z // z^5
		   + C(+5.0000000000000000e-01, 0) ) * z // z^4
		  + C(0, -7.5225277806367508e-01) ) * z // z^3
		 + C(-1.0000000000000000e+00, 0) ) * z // z^2
		+ C(0, +1.1283791670955126e+00) ) * z // z^1
	    + 1.;
    }

// ------------------------------------------------------------------------------
// Case |z| -> infty: Asymptotic expansion
// ------------------------------------------------------------------------------

    if (z2 >= 49) {
	_cerf_cmplx ret = 0.; // return value
	const double xs = y < 0 ? -creal(z) : creal(z); // compute for -z if y < 0

	if (z2 > 4.6e16) {
	    // Scale to prevent overflow.
	    if (xa > ya) {
		const double yax = ya / xs;
		const double denom = 0.56418958354775629 / (xs + yax*ya);
		ret = C(denom*yax, denom);
	    } else if (isinf(ya)) {
		// xa cannot be NaN here, since then z2 were NaN, contradicting z2 >= 49
		return (y < 0 ? C(NaN, NaN) : C(0, 0));
	    } else {
		const double xya = xs / ya;
		const double denom = 0.56418958354775629 / (xya*xs + ya);
		ret = C(denom, denom*xya);
	    }

        } else if (z2 > 28000) {
            ret = w_asymptotic(xs, ya, z2, 4);
        } else if (z2 > 120) {
            ret = w_asymptotic(xs, ya, z2, 12);
        } else {
            ret = w_asymptotic(xs, ya, z2, 23);
        }
        if (y < 0) {
            // Use w(z) = 2.0*exp(-z*z) - w(-z),
            // but be careful of overflow in exp(-z*z) = exp(-(xs*xs-ya*ya) -2*i*xs*ya)
            return 2.0 * cerf_cexp_mz2(xs, ya) - ret;
        } else
            return ret;
    }

// ------------------------------------------------------------------------------
// Taylor around some z
// ------------------------------------------------------------------------------

    if (isnan(xa))
	return C(xa, xa);

    if (isnan(y))
	return C(y, y);

    const int iTile = 2 * ((int)(inverseA*xa)*nXcover + (int)(inverseA*ya));
    const int kP = Tiles[iTile];
    assert(kP >= 0);
    const double* T = &TaylorCoeffs[2*(NTay+1)*kP];
    const _cerf_cmplx dz = C(xa - T[0], ya - T[1]);
    const int Nk = Tiles[iTile+1];
    _cerf_cmplx ret = C(T[2*Nk], T[2*Nk+1]);
    for (int k = Nk-1; k >= 1; --k)
	ret = ret * dz + C(T[2*k], T[2*k+1]);

    // Close to the real axis, recompute the small component; see above.
    if (ya < 1e-2 * xa)
	ret = C(re_w_near_axis(xa, ya), cimag(ret));

    if (y < 0) {
	if (x < 0)
	    return 2.0 * cerf_cexp_mz2(x, y) - ret;
	return 2.0 * cerf_cexp_mz2(x, y) - C(creal(ret), -cimag(ret));
    }
    if (x < 0)
	ret = C(creal(ret), -cimag(ret));
    return ret;

} // w_of_z
