# Functions for ODE-Solver: ddebdf

"""Name for Loading ddebdf solver (64bit integers)."""
const DL_DDEBDF = "ddebdf"

"""Name for Loading ddebdf solver (32bit integers)."""
const DL_DDEBDF_I32 = "ddebdf_i32"

"""macro for import Ddebdf solver."""
macro import_ddebdf()
    return :(
        using ODEInterface: ddebdf, ddebdf_i32
    )
end

"""macro for import Ddebdf dynamic lib names."""
macro import_DLddebdf()
    return :(
        using ODEInterface: DL_DDEBDF, DL_DDEBDF_I32
    )
end

"""macro for importing Ddebdf help."""
macro import_ddebdf_help()
    return :(
        using ODEInterface: help_ddebdf_compile, help_ddebdf_license
    )
end

"""
Type encapsulating all required data for Ddebdf-Solver-Callbacks.

We have the typical calling stack:

     ddebdf
         call_julia_output_fcn(  ... INIT ... )
             output_fcn ( ... INIT ...)
         loop with iterations (intermediate-mode and/or OPT_OUTPUTATTIMES)
         │ ccall( DDEBDF_ ... ) # after 1st call: continuation call
         │    ┌───────────────────────────────────────────┐  ⎫
         │    │unsafe_SLATEC1RHSCallback                  │  ⎬ cb. rhs
         │    │    rhs                                    │  ⎪
         │    └───────────────────────────────────────────┘  ⎭
         │    ┌───────────────────────────────────────────┐  ⎫
         │    │unsafe_SLATEC1JacCallback                  │  ⎬ cb. jacobian
         │    │    call_julia_jac_fcn(             )      │  ⎪
         │    └───────────────────────────────────────────┘  ⎭
         └ call_julia_output_fcn( ... STEP ...)
         call_julia_output_fcn(  ... DONE ... )
             output_fcn ( ... DONE ...)

see also help of `ODEInterface.SLATEC_continuation_call`.
"""
mutable struct DdebdfInternalCallInfos{
        FInt <: FortranInt,
        RHS_F, OUT_F, JAC_F, VIEW_F,
    } <: ODEinternalCallInfos
    logio::IO                    # where to log
    loglevel::UInt64                # log level
    # RHS:
    N::FInt                  # Dimension of Problem
    rhs::RHS_F                 # right-hand-side
    rhs_mode::RHS_CALL_MODE         # how to call rhs
    rhs_lprefix::AbstractString        # saved log-prefix for rhs
    rhs_count::Int                   # count: number of calls to rhs
    # SOLOUT & output function
    output_mode::OUTPUTFCN_MODE        # what mode for output function
    output_fcn::OUT_F                 # the output function to call
    output_data::Dict                  # extra_data for output_fcn
    # Jacobimatrix
    jacobimatrix::JAC_F                 # function for jacobi matrix
    jacobibandstruct                      # (l,u) bandstructure or nothing
    jac_lprefix::AbstractString        # saved log-prefix for jac
    jac_count::Int                   # count: number of calls to jac
    #
    submatrix::VIEW_F                # method for generating view/sub
end

"""
     mutable struct DdebdfArguments{FInt} <: AbstractArgumentsODESolver{FInt}

Stores Arguments for Ddebdf solver.

FInt is the Integer type used for the fortran compilation.
"""
mutable struct DdebdfArguments{FInt <: FortranInt} <: AbstractArgumentsODESolver{FInt}
    FCN::Ptr{Cvoid}        # rhs callback
    N::Vector{FInt}      # Dimension: NEQ
    t::Vector{Float64}   # start time (and current)
    x::Vector{Float64}   # initial value (and current state)
    tEnd::Vector{Float64}   # (current) end time
    INFO::Vector{FInt}      # INFO-Array
    RTOL::Vector{Float64}   # relative tolerance
    ATOL::Vector{Float64}   # absolute tolerance
    IDID::Vector{FInt}      # Status code
    RWORK::Vector{Float64}   # double working array
    LRW::Vector{FInt}      # length of WORK
    IWORK::Vector{FInt}      # integer working array
    LIW::Vector{FInt}      # length of IWORK
    RPAR::Vector{Float64}   # add. double-array
    IPAR::Ref{DdebdfInternalCallInfos} # misuse IPAR
    JAC::Ptr{Cvoid}        # Jacobian callback
    ## Allow uninitialized construction
    function DdebdfArguments{FInt}(dummy::FInt) where {FInt}
        return new{FInt}()
    end
end

"""
     function ddebdf(rhs, t0::Real, T::Real,
                     x0::Vector, opt::AbstractOptionsODE)
         -> (t,x,retcode,stats)

`retcode` can have the following values:

      1: computation successful
      2: computation. successful, but interrupted by output function
     <0: error

main call for using Fortran-ddebdf solver. In `opt` the following
options are used:

    ╔═════════════════╤══════════════════════════════════════════╤═════════╗
    ║  Option OPT_…   │ Description                              │ Default ║
    ╠═════════════════╪══════════════════════════════════════════╪═════════╣
    ║ RTOL         &  │ relative and absolute error tolerances   │    1e-3 ║
    ║ ATOL            │ both scalars or both vectors with the    │    1e-6 ║
    ║                 │ length of length(x0)                     │         ║
    ║                 │ error(xₖ) ≤ OPT_RTOLₖ⋅|xₖ|+OPT_ATOLₖ     │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ OUTPUTFCN       │ output function                          │ nothing ║
    ║                 │ see help_outputfcn                       │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ OUTPUTMODE      │ OUTPUTFCN_NEVER:                         │   NEVER ║
    ║                 │   dont't call OPT_OUTPUTFCN              │         ║
    ║                 │ OUTPUTFCN_WODENSE                        │         ║
    ║                 │   call OPT_OUTPUTFCN either              │         ║
    ║                 │   (a) either for all intermediate steps  │         ║
    ║                 │       chosen by the solver or           │         ║
    ║                 │   (b) at the times given in the option   │         ║
    ║                 │       OPT_OUTPUTATTIMES                  │         ║
    ║                 │ OUTPUTFCN_DENSE                          │         ║
    ║                 │   is *not* supported!                    │         ║
    ║                 │   but see OUTPUTATTIMES for an           │         ║
    ║                 │   alternative approach                   │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ OUTPUTATTIMES   │ If OPT_OUTPUTMODE is OUTPUTFCN_WODENSE   │ nothing ║
    ║                 │ then one can specify with this vector    │         ║
    ║                 │ the time points where the OPT_OUTPUTFCN  │         ║
    ║                 │ should be called.                        │         ║
    ║                 │ All values of OPT_OUTPUTATTIMES *must*   │         ║
    ║                 │ be sorted (ascending, if T>t0, and       │         ║
    ║                 │ descending, if T<t0) and they must be    │         ║
    ║                 │ between t0 and T.                        │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ TSTOP           │ tell the solver, that it is not          │     NaN ║
    ║                 │ permissible to integrate past the point  │         ║
    ║                 │ TSTOP. If TSTOP is NaN then the solver   │         ║
    ║                 │ may integrate past T and interpolate the │         ║
    ║                 │ result at T. Sometimes there are         │         ║
    ║                 │ right-hand sides, where this is not      │         ║
    ║                 │ possible.                                │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ MAXSTEPS        │ maximal number of allowed steps          │  100000 ║
    ║                 │ (allowed intermediate steps)             │         ║
    ║                 │ between t0, T and the values given       │         ║
    ║                 │ in OPT_OUTPUTATTIMES.                    │         ║
    ║                 │ The value will be rounded up to a        │         ║
    ║                 │ multiple of 500.                         │         ║
    ║                 │ OPT_MAXSTEPS > 0                         │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ JACOBIMATRIX    │ A function providing the Jacobian for    │ nothing ║
    ║                 │ ∂f/∂x or nothing. For nothing the solver │         ║
    ║                 │ uses finite differences to calculate the │         ║
    ║                 │ Jacobian.                                │         ║
    ║                 │ The function has to be of the form:      │         ║
    ║                 │   function (t,x,J) -> nothing            │         ║
    ║                 │ Depending on OPT_JACOBIBANDSTRUCT the    │         ║
    ║                 │ argument J will then by a full or a      │         ║
    ║                 │ banded matrix, where the user-given      │         ║
    ║                 │ function has to fill in the entries.     │         ║
    ╟─────────────────┼──────────────────────────────────────────┼─────────╢
    ║ JACOBIBANDSTRUCT│ A tuple (l,u) describing the banded      │ nothing ║
    ║                 │ structure of the Jacobian or nothing if  │         ║
    ║                 │ the Jacobian is full.                    │         ║
    ║                 │ Even if the option JACOBIMATRIX is empty,│         ║
    ║                 │ the solver will perform much better if   │         ║
    ║                 │ the Jacobian matrix is banded and the    │         ║
    ║                 │ code is told this.                       │         ║
    ║                 │ see also help of BandedMatrix            │         ║
    ╚═════════════════╧══════════════════════════════════════════╧═════════╝

"""
function ddebdf(
        rhs, t0::Real, T::Real,
        x0::Vector, opt::AbstractOptionsODE
    )
    return ddebdf_impl(rhs, t0, T, x0, opt, DdebdfArguments{Int64}(Int64(0)))
end

"""
ddebdf with 32bit integers, see ddebdf.
"""
function ddebdf_i32(
        rhs, t0::Real, T::Real,
        x0::Vector, opt::AbstractOptionsODE
    )
    return ddebdf_impl(rhs, t0, T, x0, opt, DdebdfArguments{Int32}(Int32(0)))
end

"""
MAXNUM value in ddebdf.
"""
const ddebdf_maxnum = 500

"""
     function ddebdf_impl(rhs,
             t0::Real, T::Real, x0::Vector, opt::AbstractOptionsODE,
             args::DdebdfArguments{FInt}) where FInt<:FortranInt

implementation of ddebdf-call for FInt.

This solver has the concept of continuation calls (CC), see
help for `ODEInterface.SLATEC_continuation_call`.

This CC are used in this method to get the solution at user-given
t-values (see `OPT_OUTPUTATTIMES`) in order to support some alternative
method for dense output.

The solver also has an intermediate-output mode. If activated then
the numerical integration is stopped at every (solver-chosen) intermediate
step and can be continued with a CC.

Different cases for this method:

    ╔═══════════════════╤═══════════════════╤════════════════════╤═════════╗
    ║ OPT_OUTPUTMODE    │ OPT_OUTPUTATTIMES │ intermediate-mode? │  case   ║
    ╠═══════════════════╪═══════════════════╪════════════════════╪═════════╣
    ║ OUTPUTFCN_NEVER   │ <ignored>         │ no   INFO(3)=0     │  C1     ║
    ║ OUTPUTFCN_WODENSE │ nothing or empty  │ yes  INFO(3)=1     │  C2     ║
    ║ OUTPUTFCN_WODENSE │ given vector      │ no   INFO(3)=0     │  C3     ║
    ╠═══════════════════╪═══════════════════╧════════════════════╧═════════╣
    ║ OUTPUTFCN_DENSE   │        N O T    S U P P O R T E D !              ║
    ╚═══════════════════╧══════════════════════════════════════════════════╝

"""
function ddebdf_impl(
        rhs,
        t0::Real, T::Real, x0::Vector, opt::AbstractOptionsODE,
        args::DdebdfArguments{FInt}
    ) where {FInt <: FortranInt}

    (lio, l, l_g, l_solver, lprefix) = solver_start("ddebdf", rhs, t0, T, x0, opt)

    method_ddebdf, = getAllMethodPtrs(
        (FInt == Int64) ? DL_DDEBDF : DL_DDEBDF_I32
    )

    (d, nrdense, scalarFlag, rhs_mode, output_mode, output_fcn) =
        solver_extract_commonOpt(t0, T, x0, opt, args)

    check_slatec_output_mode(output_mode)

    (jacobimatrix, jacobibandstruct) = extractSlatecJacobiOpt(d, opt)

    # INFO
    args.INFO = zeros(FInt, 15)

    # RWORK
    args.LRW = [
        FInt(
            jacobibandstruct === nothing ?
                250 + 10 * d + d * d : 250 + 10 * d + (2 * jacobibandstruct[1] + jacobibandstruct[2] + 1) * d
        ),
    ]
    args.RWORK = zeros(Float64, args.LRW[1])

    # IWORK
    args.LIW = [FInt(56 + d)]
    args.IWORK = zeros(FInt, args.LIW[1])

    args.INFO[1] = 0
    args.INFO[2] = scalarFlag ? 0 : 1

    maxsteps = 0
    try
        maxsteps = convert(Int, getOption(opt, OPT_MAXSTEPS, 100000))
        @assert 0 < maxsteps
    catch e
        throw(ArgumentErrorODE("OPT_MAXSTEPS is not valid", :opt, e))
    end

    tstop = NaN
    try
        tstop = convert(Float64, getOption(opt, OPT_TSTOP, NaN))
    catch e
        throw(ArgumentErrorODE("Cannot convert OPT_TSTOP to Float64", :opt, e))
    end
    args.INFO[4] = isnan(tstop) ? 0 : 1
    if !isnan(tstop)
        args.RWORK[1] = tstop
    end

    args.INFO[5] = jacobimatrix === nothing ? 0 : 1
    if jacobibandstruct !== nothing
        args.INFO[6] = 1
        args.IWORK[1] = jacobibandstruct[1]
        args.IWORK[2] = jacobibandstruct[2]
    else
        args.INFO[6] = 0
    end

    t_values = extractSlatecOutputAtTimes(t0, T, opt)
    output_attimes_given = length(t_values) > 0
    push!(t_values, args.tEnd[1])

    args.RPAR = zeros(Float64, 0)
    args.IDID = zeros(FInt, 1)
    rhs_lprefix = "unsafe_SLATEC1RHSCallback: "
    jac_lprefix = "unsafe_SLATEC1JacCallback: "

    case = output_mode == OUTPUTFCN_NEVER ? 1 : (output_attimes_given ? 3 : 2)

    args.INFO[3] = (case == 2) ? 1 : 0
    retcode = -100

    cbi = DdebdfInternalCallInfos(
        lio, l, d, rhs, rhs_mode, rhs_lprefix,
        0, output_mode, output_fcn, Dict(),
        jacobimatrix === nothing ? dummy_func : jacobimatrix,
        jacobibandstruct, jac_lprefix, 0, get_view_function()
    )

    args.IPAR = cbi
    args.FCN = unsafe_SLATEC1RHSCallback_c(cbi, FInt(0))
    args.JAC = unsafe_SLATEC1JacCallback_c(cbi, FInt(0))

    if output_mode ≠ OUTPUTFCN_NEVER
        call_julia_output_fcn(
            cbi, OUTPUTFCN_CALL_INIT,
            args.t[1], args.tEnd[1], args.x, eval_sol_fcn_init
        ) # ignore result
        call_julia_output_fcn(
            cbi, OUTPUTFCN_CALL_STEP,
            args.t[1], args.t[1], args.x, eval_sol_fcn_noeval
        )  # 1 step
    end

    if l_solver
        println(lio, lprefix, "call Fortran-ddebdf $method_ddebdf with")
        dump(lio, args)
    end

    maxsteps_seen = 0
    while (true)
        told = args.t[1]
        args.tEnd[1] = t_values[1]
        ccall(
            method_ddebdf, Cvoid,
            (
                Ptr{Cvoid}, Ptr{FInt},                       # Rightsidefunc, N=NEQ=d
                Ptr{Float64}, Ptr{Float64}, Ptr{Float64},    # t, x, tEnd
                Ptr{FInt}, Ptr{Float64}, Ptr{Float64},       # INFO, RTOL, ATOL,
                Ptr{FInt},                                   # IDID
                Ptr{Float64}, Ptr{FInt},                     # RWORK, LRW
                Ptr{FInt}, Ptr{FInt},                        # IWORK, LIW
                Ptr{Float64}, Ref{DdebdfInternalCallInfos},  # RPAR, IPAR=CBI
                Ptr{Cvoid},                                  # DJAC
            ),
            args.FCN, args.N,
            args.t, args.x, args.tEnd,
            args.INFO, args.RTOL, args.ATOL,
            args.IDID,
            args.RWORK, args.LRW,
            args.IWORK, args.LIW,
            args.RPAR, args.IPAR,
            args.JAC
        )
        if l_solver
            println(lio, lprefix, "call Fortran-ddebdf $method_ddebdf returned")
            dump(lio, args)
        end
        if args.IDID[1] < -1     # -1 handled below
            retcode = Int(args.IDID[1])
            break
        end
        if args.IDID[1] ≥ 0 && output_mode ≠ OUTPUTFCN_NEVER
            out_result = call_julia_output_fcn(
                cbi, OUTPUTFCN_CALL_STEP,
                told, args.t[1], args.x, eval_sol_fcn_noeval
            )
            if out_result == OUTPUTFCN_RET_CONTINUE_XCHANGED
                throw(
                    FeatureNotSupported(
                        string(
                            "Sorry; ddebdf does not support ",
                            "to change the solution inside the output function."
                        )
                    )
                )
            elseif out_result == OUTPUTFCN_RET_STOP
                retcode = 2
                break
            end
        end
        if args.IDID[1] == -1
            # => MAXNUM steps done
            maxsteps_seen += ddebdf_maxnum
            if maxsteps_seen ≥ maxsteps
                retcode = -1
                break
            end
        elseif args.IDID[1] == 1
            # => intermediate-output mode => case C2
            # args.tEnd[1] yet not reached => continue
            args.INFO[1] = 1
        elseif args.IDID[1] ∈ (2, 3)
            # => args.tEnd[1] reached
            popfirst!(t_values)     # next t-value to compute
            maxsteps_seen = 0
            if length(t_values) == 0
                retcode = 1   # reached T
                break
            end
        else
            throw(
                InternalErrorODE(
                    string("unknown IDID=", args.IDID[1], " result of ddebdf")
                )
            )
        end
        args.INFO[1] = 1  # continuation call
    end

    output_mode ≠ OUTPUTFCN_NEVER &&
        call_julia_output_fcn(
        cbi, OUTPUTFCN_CALL_DONE,
        args.t[1], args.tEnd[1], args.x, eval_sol_fcn_done
    ) # ignore result

    l_g && println(lio, lprefix, string("done IDID=", args.IDID[1]))
    stats = Dict{AbstractString, Any}(
        "no_rhs_calls" => cbi.rhs_count,
        "no_jac_calls" => cbi.jac_count,
        "ddebdf_idid" => args.IDID[1],
    )

    return (args.t[1], args.x, retcode, stats)
end

"""
## Compile DDEBDF

The julia ODEInterface tries to compile and link the solvers
automatically at the build-time of this module. The following
calls need only be done, if one uses a different compiler and/or if
one wants to change/add some compiler options.

The Fortran source code can be found at:

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

See `help_ddebdf_license` for the license information.

### Using `gfortran` and 64bit integers (Linux, Mac and Windows)

Here is an example how to compile DDEBDF with `Float64` reals and
`Int64` integers with `gfortran`:

     gfortran -c -fPIC -fdefault-integer-8
              -fdefault-real-8 -fdefault-double-8 -o slatec.o slatec.f
     gfortran -c -fPIC -fdefault-integer-8
              -fdefault-real-8 -fdefault-double-8 -o ddebdf.o ddbdfm.f

In order to get create a shared library (from the object file above) use
one of the forms below (1st for Linux, 2nd for Mac, 3rd for Window):

     gfortran -shared -fPIC -o ddebdf.so ddebdf.o slatec.o
     gfortran -shared -fPIC -o ddebdf.dylib ddebdf.o slatec.o
     gfortran -shared       -o ddebdf.dll ddebdf.o slatec.o
"""
function help_ddebdf_compile()
    return Docs.doc(help_ddebdf_compile)
end

function help_ddebdf_license()
    return Docs.doc(help_ddebdf_license)
end

@doc(@doc(SLATEC_license), help_ddebdf_license)

# Add information about solver in global solverInfo-array.
push!(
    solverInfo,
    SolverInfo(
        "ddebdf",
        "Backward Differentiation Formula (orders: 1-5)",
        tuple(
            :OPT_RTOL, :OPT_ATOL, :OPT_RHS_CALLMODE,
            :OPT_OUTPUTMODE, :OPT_OUTPUTFCN,
            :OPT_OUTPUTATTIMES,
            :OPT_TSTOP, :OPT_MAXSTEPS,
            :OPT_JACOBIMATRIX, :OPT_JACOBIBANDSTRUCT,
        ),
        tuple(
            SolverVariant(
                "ddebdf_i64",
                "Ddebdf with 64bit integers",
                DL_DDEBDF,
                tuple("ddebdf")
            ),
            SolverVariant(
                "ddebdf_i32",
                "Ddebdf with 32bit integers",
                DL_DDEBDF_I32,
                tuple("ddebdf")
            ),
        ),
        help_ddebdf_compile,
        help_ddebdf_license,
    )
)


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