# Functions used for SLATEC Solvers like DDEABM

"""
Some solvers have the concept of continuation calls (CC). This can be used
to get some "kind" of dense output support. How does this work?

Typically the solver "overshoots" beyond T for calculating the solution
at T (then with the help of interpolation):

                                                ↓ intermediate steps
     ──╫───┼────┼────┼─╫───┼─────             ──┼──
       t₀              T

[Use `OPT_TSTOP` if the right-hand side is not defined for some t>T or
if there are singularities.]

If you do a CC and you want the solution at new Tₙ, then in the situation

     ──╫───┼────┼────┼─╫──╫┼─────
       t₀              T  Tₙ

where Tₙ is in the already computed interval, the solution at Tₙ can be
computed simply by interpolation.
If Tₙ is beyond the last computed interval then the solver continues with
the process of numerical integration.

So CC can be cheap and the solver is optimized for CC. CC are much more
efficient than a "restart" at T.
"""
const SLATEC_continuation_call = nothing

"""
## License

The solver ddeabm is part of the SLATEC Common Mathematical Library which
is in the public domain. More information can be found at

     http://www.netlib.org/slatec/guide

"""
const SLATEC_license = nothing

"""
checks if output mode is supported and gives hint to
`OPT_OUTPUTATTIMES` if the mode `OUTPUTFCN_DENSE` was requested.
"""
function check_slatec_output_mode(output_mode::OUTPUTFCN_MODE)
    if output_mode == OUTPUTFCN_DENSE
        throw(
            ArgumentErrorODE(
                string(
                    "Option 'OPT_OUTPUTMODE': Dense output not supported by this ",
                    "solver. See description of 'OPT_OUTPUTMODE' and ",
                    "'OPT_OUTPUTATTIMES' for the possibility to get the solution at ",
                    "predefined time values"
                ),
                :opt
            )
        )
    end
    return nothing
end

"""
     function extractSlatecJacobiOpt(d::FInt,
             opt::AbstractOptionsODE) where FInt<:FortranInt

extracts jacobi options for some SLATEC solvers, like ddebdf.
"""
function extractSlatecJacobiOpt(
        d::FInt,
        opt::AbstractOptionsODE
    ) where {FInt <: FortranInt}
    OPT, jacobimatrix, jacobibandstruct = nothing, nothing, nothing
    try
        OPT = OPT_JACOBIMATRIX
        jacobimatrix = getOption(opt, OPT, nothing)
        # @assert jacobimatrix === nothing || isa(jacobimatrix,Function)

        OPT = OPT_JACOBIBANDSTRUCT
        bs = getOption(opt, OPT, nothing)

        if bs !== nothing
            jacobibandstruct = (convert(FInt, bs[1]), convert(FInt, bs[2]))
            @assert 0 ≤ jacobibandstruct[1] ≤ d
            @assert 0 ≤ jacobibandstruct[2] ≤ d
        end
    catch e
        throw(ArgumentErrorODE("Option '$OPT': Not valid", :opt, e))
    end
    return (jacobimatrix, jacobibandstruct)
end

"""
handles OPT_OUTPUTATTIMES for some SLATEC solvers, like ddeabm, ddebdf.

returns always an Float64-Vector. Even if nothing was given by the user.
If there was a vector given then it is copied and checked for
monotonicity.
"""
function extractSlatecOutputAtTimes(t0, T, opt::AbstractOptionsODE)
    t_values = getOption(opt, OPT_OUTPUTATTIMES, nothing)
    if t_values === nothing
        t_values = zeros(Float64, 0)
    end
    output_attimes_given = length(t_values) > 0

    # convert *and* copy given OPT_OUTPUTATTIMES
    # "copy", because t_values will (typically) be changed by the caller
    try
        t_values = getVectorCheckLength(t_values, Float64, length(t_values), true)
    catch e
        throw(
            ArgumentErrorODE(
                string(
                    "I've a problem converting OPT_OUTPUTATTIMES to a ",
                    "Float64-Vector"
                ), :opt, e
            )
        )
    end

    if output_attimes_given
        s = sign(T - t0)
        if any(x -> sign(x) != s, diff(t_values))
            throw(
                ArgumentErrorODE(
                    string(
                        "Because sign(T-t0)=sign($T-$t0)=$s ",
                        "the vector in OPT_OUTPUTATTIMES has to be ",
                        (T ≥ t0 ? "ascending" : "descending"),
                        ". But this is not the case."
                    ), :opt
                )
            )
        end
        if s * (t0 - t_values[1]) ≥ 0 || s * (t_values[end] - T) ≥ 0
            throw(
                ArgumentErrorODE(
                    string(
                        "All values of OPT_OUTPUTATTIMES ",
                        "must be between t0=$t0 and T=$T"
                    ), :opt
                )
            )
        end
    end

    return t_values::Vector{Float64}
end

"""
     function unsafe_SLATEC1RHSCallback(
             t_::Ptr{Float64}, x_::Ptr{Float64}, f_::Ptr{Float64},
             rpar_::Ptr{Float64}, cbi::CI) where CI<:ODEinternalCallInfos

This is the right-hand side given as callback to SLATEC solvers,
e.g. ddeabm.

The `unsafe` prefix in the name indicates that no validations are
performed on the `Ptr`-arguments.
"""
function unsafe_SLATEC1RHSCallback(
        t_::Ptr{Float64}, x_::Ptr{Float64}, f_::Ptr{Float64},
        rpar_::Ptr{Float64}, cbi::CI
    ) where {CI <: ODEinternalCallInfos}
    n = cbi.N
    t = unsafe_load(t_)
    x = unsafe_wrap(Array, x_, (n,), own = false)
    f = unsafe_wrap(Array, f_, (n,), own = false)

    cbi.rhs_count += 1
    hw1rhs(n, t, x, f, cbi)
    return nothing
end

"""
     function unsafe_SLATEC1RHSCallback_c(cbi::CI,
             fint_flag::FInt) where {FInt,CI}
        -> C-callable function pointer

This method generates a Pointer to C-callable instructions.
The two method type parameters `FInt` and `CI` are important:
`FInt` is the used Fortran integer type and `CI` is the used
`ODEinternalCallInfos` *SubType*.
Because `unsafe_SLATEC1RHSCallback` is a parameterized method,
special variants are compiled, if `FInt` or `CI` changes.
If `CI` itself is a parameterized type (depending on all the
user-given Julia-functions like right-hand side, etc.) then
calls to such Julia-functions can be resolved at compile-time
(instead of dynamic calls during run-time).
"""
function unsafe_SLATEC1RHSCallback_c(
        cbi::CI,
        fint_flag::FInt
    ) where {FInt, CI}
    return @cfunction(
        unsafe_SLATEC1RHSCallback, Cvoid, (
            Ptr{Float64},
            Ptr{Float64}, Ptr{Float64}, Ptr{Float64}, Ref{CI},
        )
    )
end


function unsafe_SLATEC1JacCallback(
        t_::Ptr{Float64}, x_::Ptr{Float64},
        dfx_::Ptr{Float64}, dfx_rows_::Ptr{FInt}, rpar_::Ptr{Float64},
        cbi::CI
    ) where {FInt <: FortranInt, CI <: ODEinternalCallInfos}
    n = cbi.N
    t = unsafe_load(t_)
    x = unsafe_wrap(Array, x_, (n,), own = false)
    dfx_rows = unsafe_load(dfx_rows_)
    M = unsafe_wrap(Array, dfx_, (dfx_rows, n), own = false)

    cbi.jac_count += 1

    lprefix = cbi.jac_lprefix
    (lio, l) = (cbi.logio, cbi.loglevel)
    l_jac = l & LOG_JAC > 0

    l_jac && println(lio, lprefix, "called with dfx_rows=", dfx_rows, " t=", t)
    jac = cbi.jacobimatrix
    jb = cbi.jacobibandstruct
    if jb === nothing
        @assert dfx_rows == n
        J = M
        jac(t, x, J)
    else
        @assert dfx_rows ≥ 1 + 2 * jb[1] + jb[2]
        banded_memory = cbi.submatrix(M, (1 + jb[1]):(1 + 2 * jb[1] + jb[2]), :)
        J = BandedMatrix{Float64}(n, n, jb[1], jb[2], banded_memory)
        jac(t, x, J)
    end
    l_jac && println(lio, lprefix, "dfx=", M)
    return nothing
end

"""
     function unsafe_SLATEC1JacCallback_c(cbi::CI,
             fint_flag::FInt) where {FInt, CI}
        -> C-callable function pointer
"""
function unsafe_SLATEC1JacCallback_c(
        cbi::CI,
        fint_flag::FInt
    ) where {FInt, CI}
    return @cfunction(
        unsafe_SLATEC1JacCallback, Cvoid, (
            Ptr{Float64},
            Ptr{Float64}, Ptr{Float64}, Ptr{FInt}, Ptr{Float64}, Ref{CI},
        )
    )
end

# vim:syn=julia:cc=79:fdm=indent:
