#include "../gmx_lapack.h"

void F77_FUNC(dlasd0, DLASD0)(int*    n,
                              int*    sqre,
                              double* d__,
                              double* e,
                              double* u,
                              int*    ldu,
                              double* vt,
                              int*    ldvt,
                              int*    smlsiz,
                              int*    iwork,
                              double* work,
                              int*    info)
{
    int u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;

    int    i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf, iwk, lvl, ndb1, nlp1, nrp1;
    double beta;
    int    idxq, nlvl;
    double alpha;
    int    inode, ndiml, idxqc, ndimr, itemp, sqrei;
    int    c__0 = 0;


    --d__;
    --e;
    u_dim1   = *ldu;
    u_offset = 1 + u_dim1;
    u -= u_offset;
    vt_dim1   = *ldvt;
    vt_offset = 1 + vt_dim1;
    vt -= vt_offset;
    --iwork;
    --work;

    *info = 0;

    if (*n < 0)
    {
        *info = -1;
    }
    else if (*sqre < 0 || *sqre > 1)
    {
        *info = -2;
    }

    m = *n + *sqre;

    if (*ldu < *n)
    {
        *info = -6;
    }
    else if (*ldvt < m)
    {
        *info = -8;
    }
    else if (*smlsiz < 3)
    {
        *info = -9;
    }
    if (*info != 0)
    {
        return;
    }

    if (*n <= *smlsiz)
    {
        F77_FUNC(dlasdq, DLASDQ)
        ("U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info);
        return;
    }

    inode = 1;
    ndiml = inode + *n;
    ndimr = ndiml + *n;
    idxq  = ndimr + *n;
    iwk   = idxq + *n;
    F77_FUNC(dlasdt, DLASDT)(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr], smlsiz);

    ndb1 = (nd + 1) / 2;
    ncc  = 0;
    i__1 = nd;
    for (i__ = ndb1; i__ <= i__1; ++i__)
    {

        i1    = i__ - 1;
        ic    = iwork[inode + i1];
        nl    = iwork[ndiml + i1];
        nlp1  = nl + 1;
        nr    = iwork[ndimr + i1];
        nrp1  = nr + 1;
        nlf   = ic - nl;
        nrf   = ic + 1;
        sqrei = 1;
        F77_FUNC(dlasdq, DLASDQ)
        ("U",
         &sqrei,
         &nl,
         &nlp1,
         &nl,
         &ncc,
         &d__[nlf],
         &e[nlf],
         &vt[nlf + nlf * vt_dim1],
         ldvt,
         &u[nlf + nlf * u_dim1],
         ldu,
         &u[nlf + nlf * u_dim1],
         ldu,
         &work[1],
         info);
        if (*info != 0)
        {
            return;
        }
        itemp = idxq + nlf - 2;
        i__2  = nl;
        for (j = 1; j <= i__2; ++j)
        {
            iwork[itemp + j] = j;
        }
        if (i__ == nd)
        {
            sqrei = *sqre;
        }
        else
        {
            sqrei = 1;
        }
        nrp1 = nr + sqrei;
        F77_FUNC(dlasdq, DLASDQ)
        ("U",
         &sqrei,
         &nr,
         &nrp1,
         &nr,
         &ncc,
         &d__[nrf],
         &e[nrf],
         &vt[nrf + nrf * vt_dim1],
         ldvt,
         &u[nrf + nrf * u_dim1],
         ldu,
         &u[nrf + nrf * u_dim1],
         ldu,
         &work[1],
         info);
        if (*info != 0)
        {
            return;
        }
        itemp = idxq + ic;
        i__2  = nr;
        for (j = 1; j <= i__2; ++j)
        {
            iwork[itemp + j - 1] = j;
        }
    }

    for (lvl = nlvl; lvl >= 1; --lvl)
    {

        if (lvl == 1)
        {
            lf = 1;
            ll = 1;
        }
        else
        {
            i__1 = lvl - 1;
            lf   = (1 << i__1);
            ll   = (lf << 1) - 1;
        }
        i__1 = ll;
        for (i__ = lf; i__ <= i__1; ++i__)
        {
            im1 = i__ - 1;
            ic  = iwork[inode + im1];
            nl  = iwork[ndiml + im1];
            nr  = iwork[ndimr + im1];
            nlf = ic - nl;
            if (*sqre == 0 && i__ == ll)
            {
                sqrei = *sqre;
            }
            else
            {
                sqrei = 1;
            }
            idxqc = idxq + nlf - 1;
            alpha = d__[ic];
            beta  = e[ic];
            F77_FUNC(dlasd1, DLASD1)
            (&nl,
             &nr,
             &sqrei,
             &d__[nlf],
             &alpha,
             &beta,
             &u[nlf + nlf * u_dim1],
             ldu,
             &vt[nlf + nlf * vt_dim1],
             ldvt,
             &iwork[idxqc],
             &iwork[iwk],
             &work[1],
             info);
            if (*info != 0)
            {
                return;
            }
        }
    }

    return;
}
