// wigner_3j_l
// ===========
//
// Evaluate the 3j symbol f(l1) = (  l1   l2 l3)
//                                (-m2-m3 m2 m3)
// for all allowed values of l1, the other parameters being held fixed.
//
// Origin
// ------
// SLATEC, http://www.netlib.org/slatec.
//
// Keywords
// --------
// 3j coefficients, 3j symbols, Clebsch-Gordan coefficients,
// Racah coefficients, vector addition coefficients, Wigner coefficients
//
// Author
// ------
// Gordon, R. G., Harvard University
// Schulten, K., Max Planck Institute
//
// Usage
// -----
// int wigner_3j_l(double l2, double l3, double m2, double m3, double* l1min,
//                 double* l1max, double* thrcof, int ndim);
//
// Arguments
// ---------
// l2 : double
//     Parameter in 3j symbol.
// l3 : double
//     Parameter in 3j symbol.
// m2 : double
//     Parameter in 3j symbol.
// m3 : double
//     Parameter in 3j symbol.
// l1min : double*, out
//     Smallest allowable l1 in 3j symbol.
// l1max : double*, out
//     Largest allowable l1 in 3j symbol.
// thrcof : double*, out
//     Set of 3j coefficients generated by evaluating the 3j symbol for all
//     allowed values of l1.  The size of `thrcof` must be `l1max-l1min+1`
//     and `thrcof[i]` will contain f(l1min+i), i=0, 1, ..., l1max-l1min.
//     If `thrcof` is `NULL`, the function will return after `l1min` and
//     `l1max` are set, so that an array of the correct size can be allocated
//     for a subsequent function call.
// ndim : int
//     Declared length of `thrcof` in calling program. If `thrcof` is `NULL`,
//     then `ndim` should be set to 0.
//
// Returns
// -------
// ier : int
//     Error flag.
//     ier=0 No errors.
//     ier=1 Either `l2 < abs(m2)` or `l3 < abs(m3)`.
//     ier=2 Either `l2+abs(m2)` or `l3+abs(m3)` non-integer.
//     ier=3 `l1max-l1min` not an integer.
//     ier=4 `l1max` less than `l1min`.
//     ier=5 `ndim` less than `l1max-l1min+1`.
//
// Description
// -----------
// Although conventionally the parameters of the vector addition
// coefficients satisfy certain restrictions, such as being integers
// or integers plus 1/2, the restrictions imposed on input to this
// subroutine are somewhat weaker. See, for example, Section 27.9 of
// Abramowitz and Stegun or Appendix C of Volume II of A. Messiah.
// The restrictions imposed by this subroutine are
//      1. `l2 >= abs(m2)` and `l3 >= abs(m3)`;
//      2. `l2+abs(m2)` and `l3+abs(m3)` must be integers;
//      3. `l1max-l1min` must be a non-negative integer, where
//         `l1max=l2+l`3 and `l1min=max(abs(l2-l3), abs(m2+m3))`.
// If the conventional restrictions are satisfied, then these
// restrictions are met.
//
// The user should be cautious in using input parameters that do
// not satisfy the conventional restrictions. For example, the
// the subroutine produces values of
//      f(l1) = ( l1  2.5  5.8)
//              (-0.3 1.5 -1.2)
// for l1=3.3,4.3,...,8.3 but none of the symmetry properties of the 3j
// symbol, set forth on page 1056 of Messiah, is satisfied.
//
// The subroutine generates f(l1min), f(l1min+1), ..., f(l1max)
// where `l1min` and `l1max` are defined above. The sequence f(l1) is
// generated by a three-term recurrence algorithm with scaling to
// control overflow. Both backward and forward recurrence are used to
// maintain numerical stability. The two recurrence sequences are
// matched at an interior point and are normalized from the unitary
// property of 3j coefficients and Wigner's phase convention.
//
// The algorithm is suited to applications in which large quantum
// numbers arise, such as in molecular dynamics.
//
// References
// ----------
// 1. Abramowitz, M., and Stegun, I. A., Eds., Handbook of Mathematical
//    Functions with Formulas, Graphs and Mathematical Tables, NBS Applied
//    Mathematics Series 55, June 1964 and subsequent printings.
// 2. Messiah, Albert., Quantum Mechanics, Volume II, North-Holland
//    Publishing Company, 1963.
// 3. Schulten, Klaus and Gordon, Roy G., Exact recursive evaluation of 3j
//    and 6j coefficients for quantum-mechanical coupling of angular momenta,
//    J Math Phys, v 16, no. 10, October 1975, pp. 1961-1970.
// 4. Schulten, Klaus and Gordon, Roy G., Semiclassical approximations to 3j
//    and 6j coefficients for quantum-mechanical coupling of angular momenta,
//    J Math Phys, v 16, no. 10, October 1975, pp. 1971-1988.
// 5. Schulten, Klaus and Gordon, Roy G., Recursive evaluation of 3j and 6j
//    coefficients, Computer Phys Comm, v 11, 1976, pp. 269-278.
//
// Revision history
// ----------------
// 01 Jan 1975  DATE WRITTEN
// 15 May 1988  SLATEC prologue added by G. C. Nielson, NBS; parameters
//              HUGE and TINY revised to depend on D1MACH.
// 29 Dec 1989  Prologue description rewritten; other prologue sections
//              revised; LMATCH (location of match point for recurrences)
//              removed from argument list; argument IER changed to serve
//              only as an error flag (previously, in cases without error,
//              it returned the number of scalings); number of error codes
//              increased to provide more precise error information;
//              program comments revised; SLATEC error handler calls
//              introduced to enable printing of error messages to meet
//              SLATEC standards. These changes were done by D. W. Lozier,
//              M. A. McClain and J. M. Smith of the National Institute
//              of Standards and Technology, formerly NBS.
// 15 Apr 1991  Mixed type expressions eliminated; variable C1 initialized;
//              description of THRCOF expanded. These changes were done by
//              D. W. Lozier.
// 04 Nov 2020  Translation to C by N. Tessore.
//

#include <math.h>
#include <float.h>

static inline int phase(int m)
{
    return 1-2*(m&1);
}

static
int wigner_3j_l(double l2, double l3, double m2, double m3, double* l1min_out,
                double* l1max_out, double* thrcof, int ndim)
{
    // variables
    int i, index, lstep, n, nfin, nfinp1, nfinp2, nlim, nstep2;
    double a1, a1s, a2, a2s, c1, c1old, c2, cnorm, denom, dv, l1, l1min, l1max,
           newfac, oldfac, ratio, sign1, sign2, sum1, sum2, sumbac, sumfor,
           sumuni, thresh, x, x1, x2, x3, y, y1, y2, y3;

    // constants
    const double eps = .01;

    // HUGE is the square root of one twentieth of the largest floating
    // point number, approximately.
    const double huge = sqrt(DBL_MAX/20);
    const double srhuge = sqrt(huge);
    const double tiny = 1.0/huge;
    const double srtiny = 1.0/srhuge;

    const double m1 = - m2 - m3;

    // Check error condition 1.
    if((l2-fabs(m2) + eps < 0) || (l3-fabs(m3) + eps < 0))
        return 1;

    // Check error condition 2.
    if((fmod(l2+fabs(m2)+eps, 1) >= eps+eps) ||
            (fmod(l3+fabs(m3)+eps, 1) >= eps+eps))
       return 2;

    // Limits for l1
    *l1min_out = l1min = fmax(fabs(l2-l3), fabs(m1));
    *l1max_out = l1max = l2 + l3;

    // Check error condition 3.
    if(fmod(l1max-l1min+eps, 1) >= eps+eps)
        return 3;

    //  Check error condition 4.
    if(l1min >= l1max+eps)
        return 4;

    // Only report l1min and l1max.
    if(!thrcof)
        return 0;

    // Number of coefficients to compute.
    nfin = l1max-l1min+1+eps;

    // Check error condition 5.
    if(ndim < nfin)
        return 5;

    // Check whether l1 can take only one value, ie. l1min = l1max.
    if(l1min >= l1max-eps)
    {
        thrcof[0] = phase(fabs(l2+m2-l3+m3)+eps)/sqrt(l1min + l2 + l3 + 1);
        return 0;
    }

    // This is reached in case that l1 takes more than one value,
    // i.e. l1min < l1max.

    // Starting forward recursion from l1min taking nstep1 steps
    l1 = l1min;
    newfac = 0.;
    c1 = 0.;
    thrcof[0] = srtiny;
    sum1 = (l1+l1+1) * tiny;

    for(lstep = 2;; lstep += 1)
    {
        l1 = l1 + 1;

        c1old = fabs(c1);
        oldfac = newfac;
        a1 = (l1+l2+l3+1) * (l1-l2+l3) * (l1+l2-l3) * (-l1+l2+l3+1);
        a2 = (l1+m1) * (l1-m1);
        newfac = sqrt(a1*a2);

        // If l1 = 1, (l1-1) has to be factored out of dv, hence
        if(l1 < 1+eps)
        {
            c1 = - (l1+l1-1) * l1 * (m3-m2) / newfac;
        }
        else
        {
            dv = - l2*(l2+1) * m1 + l3*(l3+1) * m1 + l1*(l1-1) * (m3-m2);
            denom = (l1-1) * newfac;

            c1 = - (l1+l1-1) * dv / denom;
        }

        // If l1 = l1min + 1, the third term in the recursion equation vanishes,
        // hence
        if(lstep == 2)
        {
            x = srtiny * c1;
            thrcof[1] = x;
            sum1 = sum1 + tiny * (l1+l1+1) * (c1*c1);
            if(lstep == nfin)
                goto nobac;
        }
        else
        {
            c2 = - l1 * oldfac / denom;

            // Recursion to the next 3j coefficient x
            x = c1 * thrcof[lstep-2] + c2 * thrcof[lstep-3];
            thrcof[lstep-1] = x;
            sumfor = sum1;
            sum1 = sum1 + (l1+l1+1) * (x*x);
            if(lstep == nfin)
                break;

            // See if last unnormalized 3j coefficient exceeds srhuge
            if(fabs(x) > srhuge)
            {
                // This is reached if last 3j coefficient larger than srhuge,
                // so that the recursion series thrcof[0], ... , thrcof[lstep-1]
                // has to be rescaled to prevent overflow
                for(i = 0; i < lstep; ++i)
                {
                    if(fabs(thrcof[i]) < srtiny)
                        thrcof[i] = 0;
                    else
                        thrcof[i] = thrcof[i] / srhuge;
                }
                sum1 = sum1 / huge;
                sumfor = sumfor / huge;
                x = x / srhuge;
            }

            // As long as abs(c1) is decreasing, the recursion proceeds towards
            // increasing 3j values and, hence, is numerically stable.  Once
            // an increase of abs(c1) is detected, the recursion direction is
            // reversed.
            if(c1old <= fabs(c1))
                break;
        }
    }

    // Keep three 3j coefficients around lmatch for comparison with
    // backward recursion.
    x1 = x;
    x2 = thrcof[lstep-2];
    x3 = thrcof[lstep-3];
    nstep2 = nfin - lstep + 3;

    // Starting backward recursion from l1max taking nstep2 steps, so
    // that forward and backward recursion overlap at three points
    // l1 = lmatch+1, lmatch, lmatch-1.
    nfinp1 = nfin + 1;
    nfinp2 = nfin + 2;
    thrcof[nfin-1] = srtiny;
    sum2 = tiny * (l1max+l1max+1);

    l1 = l1max + 2;
    for(lstep = 2;; lstep += 1)
    {
        l1 = l1 - 1;

        oldfac = newfac;
        a1s = (l1+l2+l3)*(l1-l2+l3-1)*(l1+l2-l3-1)*(-l1+l2+l3+2);
        a2s = (l1+m1-1) * (l1-m1-1);
        newfac = sqrt(a1s*a2s);

        dv = - l2*(l2+1) * m1 + l3*(l3+1) * m1 + l1*(l1-1) * (m3-m2);

        denom = l1 * newfac;
        c1 = - (l1+l1-1) * dv / denom;

        // If l1 = l1max + 1, the third term in the recursion formula vanishes
        if(lstep == 2)
        {
            y = srtiny * c1;
            thrcof[nfin-2] = y;
            sumbac = sum2;
            sum2 = sum2 + tiny * (l1+l1-3) * (c1*c1);
        }
        else
        {
            c2 = - (l1 - 1) * oldfac / denom;

            // Recursion to the next 3j coefficient Y
            y = c1 * thrcof[nfinp1-lstep] + c2 * thrcof[nfinp2-lstep];

            if(lstep == nstep2)
                break;

            thrcof[nfin-lstep] = y;
            sumbac = sum2;
            sum2 = sum2 + (l1+l1-3) * (y*y);

            // See if last unnormalized 3j coefficient exceeds srhuge
            if(fabs(y) > srhuge)
            {
                // This is reached if last 3j coefficient larger than srhuge,
                // so that the recursion series thrcof[nfin-1], ... ,
                // thrcof[nfin-lstep] has to be rescaled to prevent overflow
                for(i = 1; i <= lstep; ++i)
                {
                    index = nfin - i;
                    if(fabs(thrcof[index]) < srtiny)
                        thrcof[index] = 0;
                    else
                        thrcof[index] = thrcof[index] / srhuge;
                }
                sum2 = sum2 / huge;
                sumbac = sumbac / huge;
            }
        }
    }

    // The forward recursion 3j coefficients x1, x2, x3 are to be matched
    // with the corresponding backward recursion values y1, y2, y3.
    y3 = y;
    y2 = thrcof[nfinp1-lstep];
    y1 = thrcof[nfinp2-lstep];

    // Determine now ratio such that yi = ratio * xi  (i=1,2,3) holds
    // with minimal error.
    ratio = ( x1*y1 + x2*y2 + x3*y3 ) / ( x1*x1 + x2*x2 + x3*x3 );
    nlim = nfin - nstep2 + 1;

    if(fabs(ratio) >= 1)
    {
        for(n = 0; n < nlim; ++n)
            thrcof[n] = ratio * thrcof[n];
        sumuni = ratio * ratio * sumfor + sumbac;
    }
    else
    {
        ratio = 1 / ratio;
        for(n = nlim; n < nfin; ++n)
            thrcof[n] = ratio * thrcof[n];
        sumuni = sumfor + ratio*ratio*sumbac;
    }

    goto norm;

    nobac:
    sumuni = sum1;

    // Normalize 3j coefficients
    norm:
    cnorm = 1 / sqrt(sumuni);

    // Sign convention for last 3j coefficient determines overall phase
    sign1 = copysign(1, thrcof[nfin-1]);
    sign2 = phase(fabs(l2+m2-l3+m3)+eps);
    if(sign1*sign2 < 0)
        cnorm = - cnorm;

    if(fabs(cnorm) < 1)
    {
        thresh = tiny / fabs(cnorm);
        for(n = 0; n < nfin; ++n)
        {
            if(fabs(thrcof[n]) < thresh)
                thrcof[n] = 0;
            else
                thrcof[n] = cnorm * thrcof[n];
        }
    }
    else
    {
        for(n = 0; n < nfin; ++n)
            thrcof[n] = cnorm * thrcof[n];
    }

    return 0;
}
