/* Library libcerf:
 *   Compute complex error functions, based on a new implementation of
 *   Faddeeva's w_of_z. Also provide Dawson and Voigt functions.
 *
 * File dim_w_of_x.c:
 *   Implements d_im_w_of_x, the derivative of im_w_of_x.
 *
 * 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
 */

/* This function exists for w_of_z, which expands Re w about the real axis
   where |y| << |x| and needs the first coefficient of that expansion, which
   is d/dx Im w(x). Written out it is 2/sqrt(pi) - 2 x Im w(x), a difference
   smaller than either of its terms by 1/(2 x^2); forming it that way costs
   2 x^2 times the relative error of im_w_of_x, some 200 eps at x = 7. Hence
   this dedicated implementation (issue #30).

   The function is even, and negative for |x| > 0.9241. Three branches:

   - |x| < 2.5: the difference above. Its cancellation is mild there, and
     what it multiplies is a small correction to Re w, which exp(-x^2) still
     dominates; measured below 3 eps.
   - 2.5 <= |x| < 12: a piecewise Chebyshev approximation generated by ppapp,
     which bounds the relative error by 2.3 eps. The generator requires a
     positive function, so the table holds -d/dx Im w(x) and the sign is
     restored here.
   - |x| >= 12: the asymptotic expansion
       d/dx Im w(x) = -(2/sqrt(pi)) sum_{n>=1} (2n-1)!! / (2^n x^{2n}),
     whose terms are all positive, so that the sum is free of cancellation.
     Twelve of them suffice at x = 12, fewer further out.
*/

#include "cerf.h"
#include "defs.h" // defines frexp2
#include <math.h>
#include <stdalign.h>
#include "auto_cheb_dimwofx.c"

//! Returns polynomial approximation to f(x), using auto-tabulated expansion coefficients.
//! Code taken from https://jugit.fz-juelich.de/mlz/app/ppapp,
//! see Wuttke & Kleinsorge, ACM Trans. Math. Softw. 52, 13 (2026), doi:10.1145/3805698.

static double chebApproximant(double x)
{
    // Application-specific constants:
    static const int loff = (ppapp_j0 + 1) * (1 << ppapp_M) + ppapp_l0; // precomputed offset

    // For given x, obtain mantissa xm and exponent je:
    int je;                           // will be set in next line
    const double xm = frexp2(x, &je); // sets xm and je

    // Integer arithmetics to obtain reduced coordinate t:
    const int ip = (int)((1 << (ppapp_M+1)) * xm);   // index in octave + 2^M
    const int lij = je * (1 << ppapp_M) + ip - loff; // index in lookup table
    const double t = (1 << (ppapp_M+2)) * xm - (1 + 2*ip);

    const double *const P = ppapp_Coeffs0 + lij*8;
    const double *const Q = ppapp_Coeffs1 + lij*4;
    return ((((((((((P[0]) * t
                  + P[1]) * t
                 + P[2]) * t
                + P[3]) * t
               + P[4]) * t
              + P[5]) * t
             + P[6]) * t
            + P[7]) * t
           + Q[0]) * t
          + Q[1]) * t
         + Q[2];
}

/******************************************************************************/
/*  Library function d_im_w_of_x                                              */
/******************************************************************************/

double d_im_w_of_x(double x)
{
    const double ispi = 0.5641895835477562869; // 1 / sqrt(pi)
    const double ax = fabs(x);                 // the function is even

    if (ax < ppapp_a)
        return 2 * (ispi - ax * im_w_of_x(ax));

    if (ax < ppapp_b)
        return -chebApproximant(ax);

    // Asymptotic expansion, coefficients (2/sqrt(pi)) (2n-1)!! / 2^n
    const double r2 = 1 / (ax * ax);
    if (ax < 23.2)
        return -r2 * (((((((((((+8.71171921727022827e+07 * r2 // n = 12
                              + 7.57540801501758955e+06) * r2 // n = 11
                             + 7.21467430001675151e+05) * r2  // n = 10
                            + 7.59439400001763279e+04) * r2   // n = 9
                           + 8.93458117649133419e+03) * r2    // n = 8
                          + 1.19127749019884436e+03) * r2     // n = 7
                         + 1.83273460030591451e+02) * r2      // n = 6
                        + 3.33224472782893528e+01) * r2       // n = 5
                       + 7.40498828406430132e+00) * r2        // n = 4
                      + 2.11571093830408596e+00) * r2         // n = 3
                     + 8.46284375321634474e-01) * r2          // n = 2
                    + 5.64189583547756279e-01);               // n = 1
    if (ax < 150.)
        return -r2 * (((((((+8.93458117649133419e+03 * r2
                          + 1.19127749019884436e+03) * r2
                         + 1.83273460030591451e+02) * r2
                        + 3.33224472782893528e+01) * r2
                       + 7.40498828406430132e+00) * r2
                      + 2.11571093830408596e+00) * r2
                     + 8.46284375321634474e-01) * r2
                    + 5.64189583547756279e-01);
    if (ax < 6.9e7)
        return -r2 * ((((+7.40498828406430132e+00 * r2
                       + 2.11571093830408596e+00) * r2
                      + 8.46284375321634474e-01) * r2
                     + 5.64189583547756279e-01));
    // 1-term expansion, important to avoid underflow
    return -r2 * 5.64189583547756279e-01;

} // d_im_w_of_x
