using LinearAlgebra: BlasReal
"""
a "safe" version of `floatmin`, such that `1/sfmin` does not overflow.
"""
function safemin(T)
    sfmin = floatmin(T)
    small = one(T) / floatmax(T)
    if small >= sfmin
        sfmin = small * (one(T) + eps(T))
    end
    return sfmin
end

function _scale!(A::AbstractArray{T}) where {T}
    smlnum = sqrt(safemin(real(T))) / eps(real(T))
    bignum = 1 / smlnum
    anrm = norm(A, Inf)
    scaleA = false
    cscale = one(real(T))
    if anrm > 0 && anrm < smlnum
        scaleA = true
        cscale = smlnum
    elseif anrm > bignum
        scaleA = true
        cscale = bignum
    end
    scaleA && safescale!(A, anrm, cscale)
    return scaleA, cscale, anrm
end

abs1(z) = abs(z)
abs1(z::T) where {T <: Complex} = abs(real(z)) + abs(imag(z))

# translated from xLASCL (LAPACK)
"""
multiply an array `A` by a real number `cto/cfrom` expressed as a ratio,
computing without over/underflow where possible.

`cfrom` must not be zero.
"""
function safescale!(A::AbstractArray{T}, cfrom::Real, cto::Real) where {T}
    # CHECKME: what are correct type constraints on cfrom,cto?
    isnan(cto) && throw(ArgumentError("cto must be a valid number"))
    (isnan(cfrom) || (cfrom == 0)) && throw(ArgumentError("cfrom must be a valid nonzero number"))
    smlnum = safemin(real(T))
    bignum = 1 / smlnum
    cfromc = cfrom
    ctoc = cto
    done = false
    while !done
        cfrom1 = cfromc * smlnum
        if cfrom1 == cfromc
            # cfromc is ±∞; multiplier is signed 0 or NaN
            mul = ctoc / cfromc
            done = true
            cto1 = ctoc
        else
            cto1 = ctoc / bignum
            if cto1 == ctoc
                # ctoc is 0 or ±∞, so is correct multiplier
                mul = cto
                done = true
                cfromc = one(real(T))
            elseif abs(cfrom1) > abs(ctoc) && (ctoc != 0)
                mul = smlnum
                done = false
                cfromc = one(real(T))
            elseif abs(cto1) > abs(cfromc)
                mul = bignum
                done = false
                cfromc = cfrom1
            else
                mul = ctoc / cfromc
                done = true
            end
        end
        A .= A .* mul
    end
    return
end

"compute Frobenius norm, avoiding overflow"
function _safe_fnorm(A::AbstractMatrix{Ty}) where {Ty}
    dscale, dsum = zero(real(Ty)), one(real(Ty))
    for i in 1:size(A, 2)
        dscale, dsum = _ssq(view(A, :, i), dscale, dsum)
    end
    return dscale * sqrt(dsum)
end
function _safe_fnorm(A::AbstractVector{Ty}) where {Ty}
    dscale, dsum = zero(real(Ty)), one(real(Ty))
    dscale, dsum = _ssq(A, dscale, dsum)
    return dscale * sqrt(dsum)
end

# Rank one update

## General
### BLAS
rankUpdate!(α::T, x::StridedVector{T}, y::StridedVector{T}, A::StridedMatrix{T}) where {T <: BlasReal} = BLAS.ger!(α, x, y, A)

### Generic
function rankUpdate!(α::Number, x::StridedVector, y::StridedVector, A::StridedMatrix)
    m, n = size(A, 1), size(A, 2)
    m == length(x) || throw(DimensionMismatch("x vector has wrong length"))
    n == length(y) || throw(DimensionMismatch("y vector has wrong length"))
    for j in 1:n
        yjc = y[j]'
        for i in 1:m
            A[i, j] += x[i] * α * yjc
        end
    end
    return
end

# Actually solves A[1:n,1:n] * x = s * b and returns s, a scaling factor
# such that components of x are manageable.
# NB: works with leading n×n block of A and leading n terms of b, x
# Hence all the loops must be explicit.
# This is a translation of (part of) LAPACK::zlatrs, q.v. for details.
# index-unsafe
# Provide `b` in argument `x`; note that `cnorm` may be updated.
"""
scale = _usolve!(A, n, x, cnorms)

Upper triangular solve with scaling to prevent overflow
"""
function _usolve!(A::StridedMatrix{T}, n, x, cnorm) where {T}

    cabs1half(z) = abs(real(z) / 2) + abs(imag(z) / 2)

    RT = real(T)
    half = one(RT) / 2
    smallnum = safemin(RT) / eps(RT)
    bignum = one(RT) / smallnum
    xscale = one(RT)

    tmax = abs(cnorm[1])
    @inbounds for j in 2:n
        tmax = max(tmax, abs(cnorm[j]))
    end

    if tmax <= bignum * half
        tscale = one(RT)
    else
        tscale = half / (smallnum * tmax)
        cnorm[1:n] .*= tscale
    end
    # bound on solution vector:
    xmax = cabs1half(x[1])
    @inbounds for j in 2:n
        xmax = max(xmax, cabs1half(x[j]))
    end
    xbound = xmax
    if tscale != one(RT)
        grow = zero(RT)
    else
        # compute grow
        grow = half / max(xbound, smallnum)
        xbound = grow
        toosmall = false
        for j in n:-1:1
            # give up if too small
            toosmall = (grow <= smallnum)
            toosmall && break
            tjjs = A[j, j]
            tjj = abs1(tjjs)
            if tjj >= smallnum
                xbound = min(xbound, min(one(RT), tjj) * grow)
            else
                # M[j] could overflow
                xbound = zero(RT)
            end
            if tjj + cnorm[j] >= smallnum
                grow *= (tjj / (tjj + cnorm[j]))
            else
                # grow could overflow, clamp
                grow = zero(RT)
            end
        end
        if !toosmall
            grow = xbound
        end
    end

    if grow * tscale > smallnum
        # bound is ok; use standard arithmetic
        @inbounds for j in n:-1:1
            xj = x[j] = A[j, j] \ x[j]
            for i in (j - 1):-1:1
                x[i] -= A[i, j] * xj
            end
        end
    else
        if xmax > bignum * half
            # scale so all(abs.(x) .<= bignum)
            xscale = (bignum * half) / xmax
            @inbounds for i in 1:n
                x[i] *= xscale
            end
            xmax = bignum
        else
            xmax *= 2
        end
        for j in n:-1:1
            # compute x[j] = b[j] / A[j,j], scaling if necessary
            xj = abs1(x[j])
            tjjs = A[j, j] * tscale
            tjj = abs1(tjjs)
            if tjj > smallnum
                # abs(A[j,j] > smallnum):
                if tjj < one(RT)
                    if xj > tjj * bignum
                        # scale x by 1/b[j]
                        rec = one(RT) / xj
                        @inbounds for i in 1:n
                            x[i] *= rec
                        end
                        xscale *= rec
                        xmax *= rec
                    end
                end
                x[j] = x[j] / tjjs
                xj = abs1(x[j])
            elseif tjj > 0
                # 0 < abs(A[j,j]) <= smallnum
                if xj > tjj * bignum
                    # scale by (1/abs(x[j]))*abs(A[j,j]))*bignum
                    # to avoid overflow when dividing by A[j,j]
                    rec = (tjj * bignum) / xj
                    if cnorm[j] > one(RT)
                        # scale by 1/cnorm[j] to avoid overflow
                        # when multiplying x[j] by column j
                        rec /= cnorm[j]
                    end
                    @inbounds for i in 1:n
                        x[i] *= rec
                    end
                    xscale *= rec
                    xmax *= rec
                end
                # CHECKME: may want zladiv scheme
                x[j] = x[j] / tjjs
                xj = abs1(x[j])
            else
                # A[j,j] = 0; set x to eⱼ, xscale to 0
                # and compute a null vector.
                @inbounds for i in 1:n
                    x[i] = zero(T)
                end
                x[j] = one(T)
                xscale = zero(RT)
                xmax = zero(RT)
            end
            # scale x if necc. to avoid overflow when adding multiple of A[:,j]
            if xj > one(RT)
                rec = one(RT) / xj
                if cnorm[j] > (bignum - xmax) * rec
                    # scale by 1/(2abs(x[j]))
                    rec *= half
                    @inbounds for i in 1:n
                        x[i] *= rec
                    end
                    xscale *= rec
                end
            elseif (xj * cnorm[j] > bignum - xmax)
                # scale by 1/2
                @inbounds for i in 1:n
                    x[i] *= half
                end
                xscale *= half
            end
            if j > 1
                # compute update
                xjt = x[j] * tscale
                @inbounds for i in 1:(j - 1)
                    x[i] -= xjt * A[i, j]
                end
                xmax = abs1(x[1])
                @inbounds for i in 2:(j - 1)
                    xmax = max(xmax, abs1(x[i]))
                end
            end
        end
        xscale /= tscale
    end
    if tscale != one(RT)
        @inbounds for i in 1:n
            cnorm[i] *= one(RT) / tscale
        end
    end
    return xscale
end

# conjugate transpose version
"""
scale = _cusolve!(A, n, x, cnorms)

Transpose-of-upper-triangular solve with scaling to prevent overflow
"""
function _cusolve!(A::StridedMatrix{T}, n, x, cnorm) where {T}

    cabs1half(z) = abs(real(z) / 2) + abs(imag(z) / 2)

    RT = real(T)
    half = one(RT) / 2
    #    smallnum = safemin(RT) / (2*eps(RT)) # WARNING: assumes base 2
    smallnum = safemin(RT) / eps(RT)
    bignum = one(RT) / smallnum
    xscale = one(RT)

    tmax = abs(cnorm[1])
    @inbounds for j in 2:n
        tmax = max(tmax, abs(cnorm[j]))
    end

    if tmax <= bignum * half
        tscale = one(RT)
    else
        tscale = half / (smallnum * tmax)
        cnorm[1:n] .*= tscale
    end
    # bound on solution vector:
    xmax = cabs1half(x[1])
    @inbounds for j in 2:n
        xmax = max(xmax, cabs1half(x[j]))
    end
    xbound = xmax
    if tscale != one(RT)
        grow = zero(RT)
    else
        # compute grow
        grow = half / max(xbound, smallnum)
        xbound = grow
        toosmall = false
        for j in 1:n
            # give up if too small
            toosmall = (grow <= smallnum)
            toosmall && break
            # G[j] = max(G[j-1], M[j-1]*(1+cnorm[j]))
            xj = one(RT) + cnorm[j]
            grow = min(grow, xbound / xj)
            tjjs = A[j, j]
            tjj = abs1(tjjs)
            if tjj >= smallnum
                if xj > tjj
                    xbound *= (tjj / xj)
                end
            else
                # M[j] could overflow
                xbound = zero(RT)
            end
        end
        if !toosmall
            grow = min(grow, xbound)
        end
    end

    if grow * tscale > smallnum
        # bound is ok; use standard arithmetic
        @inbounds for j in 1:n
            z = x[j]
            for i in 1:(j - 1)
                z -= conj(A[i, j]) * x[i]
            end
            x[j] = conj(A[j, j]) \ z
        end
    else
        if xmax > bignum * half
            # scale so all(abs.(x) .<= bignum)
            xscale = (bignum * half) / xmax
            @inbounds for i in 1:n
                x[i] *= xscale
            end
            xmax = bignum
        else
            xmax *= 2
        end
        for j in 1:n
            # compute x[j] = b[j] - Σ_(k≠j) A[k,j] x[k]
            xj = abs1(x[j])
            uscale = complex(tscale)
            rec = one(RT) / max(xmax, one(RT))
            if cnorm[j] > (bignum - xj) * rec
                # if x[j] could overflow scale x by 1/(2 xmax)
                rec *= half
                tjjs = conj(A[j, j]) * tscale
                tjj = abs1(tjjs)
                if tjj > one(RT)
                    # divide by A[j,j] when scaling if A[j,j] > 1
                    rec = min(one(RT), rec * tjj)
                    uscale /= tjjs
                end
                if rec < one(RT)
                    @inbounds for i in 1:n
                        x[i] *= rec
                    end
                    xscale *= rec
                    xmax *= rec
                end
            end
            csumj = zero(T)
            @inbounds for i in 1:(j - 1)
                csumj += (conj(A[i, j]) * uscale) * x[i]
            end
            if uscale == complex(tscale) || isnan(uscale)
                # if diagonal wasn't used to scale
                # compute x[j] = (x[j] - csumj) / A[j,j]
                x[j] -= csumj
                xj = abs1(x[j])
                tjjs = conj(A[j, j]) * tscale

                # compute x[j] /= A[j,j], scaling if necessary
                tjj = abs1(tjjs)
                if tjj > smallnum
                    if tjj < one(RT)
                        if xj > tjj * bignum
                            rec = one(RT) / xj
                            @inbounds for i in 1:n
                                x[i] *= rec
                            end
                            xscale *= rec
                            xmax *= rec
                        end
                    end
                    x[j] = x[j] / tjjs
                elseif tjj > zero(RT)
                    # tiny diag
                    if xj > tjj * bignum
                        rec = (tjj * bignum) / xj
                        @inbounds for i in 1:n
                            x[i] *= rec
                        end
                        xscale *= rec
                        xmax *= rec
                    end
                    x[j] = x[j] / tjjs
                else
                    # zero diag: compute a null vector of Aᴴ
                    x[1:n] .= zero(T)
                    x[j] = one(T)
                    xscale = zero(RT)
                    xmax = zero(RT)
                end
            else
                # if dot product was already divided by A[j,j]
                # compute x[j] = x[j] / A[j,j] - csumj
                # CHECKME: tjjs may not be defined here
                x[j] = x[j] / tjjs - csumj
            end
            xmax = max(xmax, abs1(x[j]))
        end
        xscale /= tscale
    end
    if tscale != one(RT)
        @inbounds for i in 1:n
            cnorm[i] *= one(RT) / tscale
        end
    end
    return xscale
end

# update scale and sumsq s.t. (scale^2 * sumsq) is increased by ∑ |x[j]|^2
# scale is a running quasi-inf-norm.
# based on LAPACK::zlassq
function _ssq(x::AbstractVector{T}, scale, sumsq) where {T}
    rone = one(real(T))
    rzero = zero(real(T))
    if isnan(scale) || isnan(sumsq)
        return scale, sumsq
    end
    if sumsq == 0
        scale = rone
    elseif scale == 0
        scale = rone
        sumsq = rzero
    end
    n = length(x)
    n > 0 || return scale, sumsq
    for ix in 1:n
        t1 = abs(real(x[ix]))
        if t1 > 0 || isnan(t1)
            if scale < t1
                sumsq = rone + sumsq * (scale / t1)^2
                scale = t1
            else
                sumsq += (t1 / scale)^2
            end
        end
        if T <: Complex
            t1 = abs(imag(x[ix]))
            if t1 > 0 || isnan(t1)
                if scale < t1
                    sumsq = rone + sumsq * (scale / t1)^2
                    scale = t1
                else
                    sumsq += (t1 / scale)^2
                end
            end
        end
    end
    return scale, sumsq
end

# stdlib norm2 uses a poorly implemented generic scheme for short vectors.
function _norm2(x::AbstractVector{T}) where {T <: Real}
    require_one_based_indexing(x)
    n = length(x)
    n < 1 && return zero(T)
    n == 1 && return abs(x[1])
    scale = zero(T)
    ssq = zero(T)
    for xi in x
        if !iszero(xi)
            a = abs(xi)
            if scale < a
                ssq = one(T) + ssq * (scale / a)^2
                scale = a
            else
                ssq += (a / scale)^2
            end
        end
    end
    return scale * sqrt(ssq)
end

function _norm2(x::AbstractVector{T}) where {T <: Complex}
    require_one_based_indexing(x)
    n = length(x)
    RT = real(T)
    n < 1 && return zero(RT)
    n == 1 && return abs(x[1])
    scale = zero(RT)
    ssq = zero(RT)
    for xx in x
        xr, xi = reim(xx)
        if !iszero(xr)
            a = abs(xr)
            if scale < a
                ssq = one(RT) + ssq * (scale / a)^2
                scale = a
            else
                ssq += (a / scale)^2
            end
        end
        if !iszero(xi)
            a = abs(xi)
            if scale < a
                ssq = one(RT) + ssq * (scale / a)^2
                scale = a
            else
                ssq += (a / scale)^2
            end
        end
    end
    return scale * sqrt(ssq)
end

# As of v1.5, Julia hypot() w/ >2 args is unprotected (the documentation lies),
# so we need this.
# translation of dlapy3, assuming NaN propagation
function _hypot3(x::T, y::T, z::T) where {T}
    xa = abs(x)
    ya = abs(y)
    za = abs(z)
    w = max(xa, ya, za)
    rw = one(real(T)) / w
    r::real(T) = w * sqrt((rw * xa)^2 + (rw * ya)^2 + (rw * za)^2)
    return r
end

function _enormalize!(v::AbstractMatrix{T}) where {T <: STypes}
    n = size(v, 1)
    for j in 1:n
        s = one(real(T)) / norm(v[:, j], 2)
        t = abs2(v[1, j])
        i0 = 1
        for i in 2:n
            u = abs2(v[i, j])
            if u > t
                i0 = i
                t = u
            end
        end
        t = s * conj(v[i0, j]) / sqrt(t)
        for i in 1:n
            v[i, j] *= t
        end
        v[i0, j] = real(v[i0, j])
    end
    return
end

"""
`x, scale, perturbed = _safe_lu_solve!(A,b)`

solve a linear algebraic problem `A * x = b` for a single vector `b`
using LU decomposition with complete pivoting, scaling to mitigate overflow,
and perturbation to circumvent singularity.
Destroys `A` and overwrites `b` with the solution `x`.

"""
function _safe_lu_solve!(A::AbstractMatrix{T}, b::AbstractVector{T}) where {T}
    n = checksquare(A)
    perturbed = false
    RT = real(T)
    smallnum = floatmin(RT) / eps(RT)
    smin = maximum(abs, A)
    smin = max(eps(RT) * smin, smallnum)
    # perform elimination
    ipsv, jpsv = 0, 0
    jpiv = fill(0, n)
    # ipiv = fill(0,n)
    for i in 1:(n - 1)
        xmax = zero(RT)
        for ip in i:n
            for jp in i:n
                if abs(A[ip, jp]) >= xmax
                    xmax = abs(A[ip, jp])
                    ipsv, jpsv = ip, jp
                end
            end
        end
        if ipsv != i
            for j in 1:n
                t1, t2 = A[ipsv, j], A[i, j]
                A[ipsv, j] = t2
                A[i, j] = t1
            end
            b[i], b[ipsv] = b[ipsv], b[i]
        end
        # ipiv[i] = ipsv
        if jpsv != i
            for j in 1:n
                t1, t2 = A[j, jpsv], A[j, i]
                A[j, jpsv] = t2
                A[j, i] = t1
            end
        end
        jpiv[i] = jpsv
        if abs(A[i, i]) < smin
            perturbed = true
            A[i, i] = smin
        end
        for j in (i + 1):n
            A[j, i] /= A[i, i]
            b[j] -= A[j, i] * b[i]
            for k in (i + 1):n
                A[j, k] -= A[j, i] * A[i, k]
            end
        end
    end
    if abs(A[n, n]) < smin
        perturbed = true
        A[n, n] = smin
    end
    jpiv[n] = n
    # ipiv[n] = n
    scale = one(RT)
    a = 8smallnum
    needscl = false
    for i in 1:n
        if a * abs(b[i]) > abs(A[i, i])
            needscl = true
            break
        end
    end
    if needscl
        scale = (1 / RT(8)) / maximum(abs, b)
        b .*= scale
    end
    for i in 1:n
        k = n + 1 - i
        t = 1 / A[k, k]
        b[k] *= t
        for j in (k + 1):n
            b[k] -= (t * A[k, j]) * b[j]
        end
    end
    for i in 1:(n - 1)
        jj = jpiv[n - i]
        if jj != n - i
            b[n - i], b[jj] = b[jj], b[n - i]
        end
    end
    return b, scale, perturbed
end

# Triangular solver used by real eigvecs() (standard and generalized).
"""
    scale, x, xnorm, perturbed = _xsolve(a,A,d,b,B)

Solve `(a * A - b * D) * X = s * B`
where `A` and `D` are `na×na` real matrices, `D` is `Diagonal(d)`, `a` is real, `b` complex.
`X` and `B` are complex vectors of length `na`; compute `s` to avoid overflow.
Perturb if necessary to escape singularity.
"""
function _xsolve(a, A::AbstractMatrix{Ty}, d::AbstractVector{Ty}, b, B, smin) where {Ty}
    # Note: currently may delegate to more general routine, overwriting B
    one_t = one(Ty)
    zero_t = zero(Ty)
    s = one_t
    na = size(A, 1)
    small = 2 * safemin(Ty)
    bignum = s / small
    smin = max(smin, small)
    perturbed = false
    if na == 1
        csr = a * A[1, 1] - real(b) * d[1]
        csi = -imag(b) * d[1]
        cnorm = abs(csr) + abs(csi)
        if cnorm < smin
            perturbed = true
            csr = smin
            csi = zero_t
            cnorm = smin
        end
        bnorm = abs1(B[1])
        if (cnorm < 1) && (bnorm > 1) && (bnorm > bignum * cnorm)
            s = one_t / bnorm
        end
        x = B[1] * s / (csr + im * csi)
        xnorm = abs1(x[1])
        B[1] = x
        return s, B, xnorm, perturbed
    end
    cmax = zero_t
    for j in 1:na
        for i in 1:na
            z = a * A[i, j] + 0im
            if i == j
                z -= b * d[i]
            end
            cmax = max(cmax, abs1(z))
        end
    end
    if cmax < smin
        perturbed = true
        bnorm = maximum(abs1, B)
        if (smin < 1) && (bnorm > 1) && (bnorm > bignum * smin)
            s = one_t / bnorm
        end
        t1 = s / smin
        rmul!(B, t1)
        x = B
    else
        x, s, _ = _safe_lu_solve!(a * A - Diagonal(complex(b) * d), B)
    end
    xnorm = norm(x)
    return s, x, xnorm, perturbed
end
