/* Library libcerf:
 *   Compute complex error functions, based on a new implementation of
 *   Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
 *
 * File exp_z2.c:
 *   Implements the functions that form exp(+-z^2) with a double-word exponent.
 *
 * Copyright:
 *   (C) 2026 Forschungszentrum Jülich GmbH
 *
 * Licence:
 *   ../LICENSE
 *
 * Authors:
 *   Joachim Wuttke, Forschungszentrum Juelich, 2026
 *
 * Website:
 *   https://jugit.fz-juelich.de/mlz/lib/cerf
 *
 * Revision history:
 *   ../CHANGELOG
 */

/* Every function that carries a factor exp(+-z^2) has to form the exponent
   Re(-z^2) = (y-x)(x+y), Im(-z^2) = -2xy and pass it to exp, sin and cos.
   Rounded into a single double it would cost the factor a relative accuracy
   of order eps |z|^2 -- three roundings enter the real part and one the
   imaginary -- which is 1080 eps at |z| = 26 and grows without bound. That is
   a limitation of the single-double exponent, not of the double format, and
   removing it is what this file is for (issue #32).

   The exponent is therefore carried as a double-word, an unevaluated sum
   s_h + s_l of two doubles with |s_l| <= eps |s_h| (Dekker, Numer. Math. 18,
   224 (1971); Muller et al., Handbook of Floating-Point Arithmetic, 2nd ed.,
   ch. 4 and 14; Joldes, Muller & Popescu, ACM Trans. Math. Softw. 44, 15
   (2017)).

   Both x*x and y*y are exact as double-words, and so is their difference, so
   that Re(-z^2) becomes available to a relative accuracy of order eps^2. The
   exponential then factorizes as

       exp(s_h + s_l) = exp(s_h) (1 + s_l + ...),

   where |s_l| <= eps |s_h| <= 8e-14 wherever the result neither overflows nor
   underflows, so that the quadratic term is already below eps and only the
   linear correction is needed. That bound on s_l holds only after the sum has
   been renormalized: where the two squares nearly cancel, the difference is
   much smaller than the residuals it is formed from. The product -2xy is
   exact as a double-word in the same way, and the phase is corrected through

       cos(b_h + b_l) = cos b_h - b_l sin b_h + ...

   and its counterpart for the sine, which likewise needs only the linear term
   as long as |b_l| is small; where it is not, cos b_l and sin b_l are formed
   explicitly, which costs two more library calls but holds for any |b_h|.

   Counting one eps for each library call and one for each correction, in
   modulus and in phase, the factor comes out to about 4 eps, uniformly in |z|.

   Nothing but the double type is involved. In particular a fused multiply-add
   is convenient but not essential: the residual of a product is delivered
   either by fma(a, b, -a*b), two operations, or by Dekker's algorithm from
   Veltkamp's splitting with the constant 2^27+1, seven operations, and the two
   return the same double, bit for bit, so that results do not depend on the
   target architecture. The C99 macro FP_FAST_FMA, which <math.h> defines
   exactly when fma() is at least as fast as a multiply plus an add, selects
   between them; it is undefined for the base x86-64 architecture, where an
   explicit fma() would be a call into libm, and defined once the FMA
   instruction is available, as under the CMake option CERF_FMA=ON.

   The splitting requires round-to-nearest without double rounding, and would
   overflow for |x| > 2^996. Both conditions hold wherever these functions are
   called: exp(-x^2) has long underflowed at |x| = 27. */

#include "cerf.h"
#include "defs.h" // defines _cerf_cmplx, C, cexp
#include "exp_z2.h"
#include <float.h>
#include <math.h>

/******************************************************************************/
/*  Exact products                                                            */
/******************************************************************************/

//! Returns x*x - h exactly, with h = x*x rounded, so that h + result = x^2.

double cerf_sqr_res(const double x, const double h)
{
#ifdef FP_FAST_FMA
    return fma(x, x, -h);
#else
    const double c = 134217729. * x; // 2^27 + 1: Veltkamp's splitting constant
    const double hx = c - (c - x);   // 26 leading bits of x
    const double tx = x - hx;        // the remaining bits, exactly
    return ((hx * hx - h) + 2. * hx * tx) + tx * tx;
#endif
}

//! Returns a*b - p exactly, with p = a*b rounded, so that p + result = a*b.

double cerf_prod_res(const double a, const double b, const double p)
{
#ifdef FP_FAST_FMA
    return fma(a, b, -p);
#else
    const double ca = 134217729. * a;
    const double ha = ca - (ca - a);
    const double ta = a - ha;
    const double cb = 134217729. * b;
    const double hb = cb - (cb - b);
    const double tb = b - hb;
    return (((ha * hb - p) + ha * tb) + ta * hb) + ta * tb;
#endif
}

/******************************************************************************/
/*  Real arguments                                                            */
/******************************************************************************/

//! Returns exp(x^2), with the exponent carried as a double-word.

double cerf_exp_x2(const double x)
{
    const double h = x * x;
    if (!(h < 750.))
        return exp(h); // overflow, or NaN; the correction would be void
    return exp(h) * (1. + cerf_sqr_res(x, h));
}

//! Returns exp(-x^2), with the exponent carried as a double-word.

double cerf_exp_mx2(const double x)
{
    const double h = x * x;
    if (!(h < 750.))
        return exp(-h); // underflow, or NaN; the correction would be void
    return exp(-h) * (1. - cerf_sqr_res(x, h));
}

/******************************************************************************/
/*  Complex arguments                                                         */
/******************************************************************************/

//! Returns |exp(-z^2)| = exp(y^2-x^2), with the exponent carried as a double-word.

double cerf_exp_mz2_mod_scaled(const double x, const double y, double* scale)
{
    *scale = 1.;

    const double th = x * x;
    const double uh = y * y;
    if (!(th <= DBL_MAX && uh <= DBL_MAX))
        // A square overflows, or an argument is NaN. Fall back to the form that
        // is safe against overflow, though inaccurate; the result is 0 or inf.
        return exp((y - x) * (x + y));
    // 2Sum of u_h and -t_h, plus the two residuals
    const double d = uh - th;
    const double bb = d - uh;
    const double e =
        ((uh - (d - bb)) + (-th - bb)) + (cerf_sqr_res(y, uh) - cerf_sqr_res(x, th));

    // Renormalize: where the two squares cancel, the residual e is not small
    // compared to their difference d, and the linear correction below would
    // leave a term e^2/2. One more 2Sum restores |s_l| <= eps |s_h| / 2.
    const double sh = d + e;
    const double cc = sh - d;
    const double sl = (d - (sh - cc)) + (e - cc);

    if (sh > 709.7) {
        // The exponential overflows. Where the factor multiplies a |w| <= 1 the
        // product may still be representable, and |w| >= 1/(sqrt(pi)|z|) bounds
        // the room by ln(sqrt(pi)|z|) <= 356. Divide out e^k with an integer k;
        // s_h being at most 1066 there, s_h - k is exact.
        if (sh > 1100.)
            return exp(sh); // inf, and no headroom could rescue it
        const double k = ceil(sh - 700.);
        *scale = exp(k);
        return exp(sh - k) * (1. + sl);
    }
    if (!(sh > -750.))
        return exp(sh); // underflow, or NaN; the correction would be void
    return exp(sh) * (1. + sl);
}

double cerf_exp_mz2_mod(const double x, const double y)
{
    double scale;
    const double m = cerf_exp_mz2_mod_scaled(x, y, &scale);
    // Overflows to infinity where the scaled form was needed, as before.
    return scale == 1. ? m : m * scale;
}

//! Returns exp(-z^2)/|exp(-z^2)| = exp(-2ixy), with the phase carried as a double-word.

_cerf_cmplx cerf_exp_mz2_arg(const double x, const double y)
{
    const double a = -2. * x; // exact unless it overflows, which the next test catches
    const double bh = a * y;
    if (!(fabs(bh) <= DBL_MAX))
        return C(cos(bh), sin(bh)); // as before: the result is NaN anyway

    const double bl = cerf_prod_res(a, y, bh);
    const double cb = cos(bh);
    const double sb = sin(bh);
    if (fabs(bl) < 1e-8)
        // The quadratic term of the correction stays below eps/2.
        return C(cb - bl * sb, sb + bl * cb);
    // |b_h| > 9e7: the quadratic term of the linear correction would exceed eps.
    const double cl = cos(bl);
    const double sl = sin(bl);
    return C(cb * cl - sb * sl, sb * cl + cb * sl);
}

//! Returns exp(-z^2) for z = x+iy, with the exponent carried as a double-word.

_cerf_cmplx cerf_cexp_mz2(const double x, const double y)
{
    const double th = x * x;
    const double uh = y * y;
    if (!(th <= DBL_MAX && uh <= DBL_MAX))
        // A square overflows, or an argument is NaN.
        return cexp(C((y - x) * (x + y), -2. * x * y));

    const double m = cerf_exp_mz2_mod(x, y);
    if (!(m > 0. && m <= DBL_MAX))
        // The exponential over- or underflows. Nothing is left to correct, and
        // the limits are delicate, so leave them to the library function as
        // before; m > 0 also excludes a NaN.
        return cexp(C((y - x) * (x + y), -2. * x * y));

    // A positive finite real factor, so that the product cannot turn a zero of
    // the phase into a NaN.
    return m * cerf_exp_mz2_arg(x, y);
}
