# Functions common for all Dopri-Solvers

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

We have the typical calling stack:

     dopri5/dop853
         call_julia_output_fcn(  ... INIT ... )
             output_fcn ( ... INIT ...)
         ccall( DOPRI5_/DOP853_ ... )
            ┌───────────────────────────────────────────┐  ⎫
            │unsafe_HW1RHSCallback                      │  ⎬ cb. rhs
            │    rhs                                    │  ⎪
            └───────────────────────────────────────────┘  ⎭
            ┌───────────────────────────────────────────┐  ⎫
            │unsafe_dopriSoloutCallback                 │  ⎪
            │    call_julia_output_fcn( ... STEP ...)   │  ⎪ cb. solout
            │        output_fcn ( ... STEP ...)         │  ⎬ with eval
            │            eval_sol_fcn                   │  ⎪
            │                ccall(CONTD5_/CONTD8_ ... )│  ⎪
            └───────────────────────────────────────────┘  ⎭
         call_julia_output_fcn(  ... DONE ... )
             output_fcn ( ... DONE ...)
"""
mutable struct DopriInternalCallInfos{
        FInt <: FortranInt,
        RHS_F, OUT_F,
    } <: ODEinternalCallInfos
    logio::IO                    # where to log
    loglevel::UInt64                # log level
    # RHS:
    rhs::RHS_F                 # right-hand-side
    rhs_mode::RHS_CALL_MODE         # how to call rhs
    rhs_lprefix::AbstractString        # saved log-prefix for 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
    out_lprefix::AbstractString        # saved log-prefix for solout
    eval_sol_fcn::Function              # eval_sol_fcn (for output_fcn)
    eval_lprefix::AbstractString        # saved log-prefix for eval_sol
    tOld::Float64               # tOld and
    tNew::Float64               # tNew and
    xNew::Vector{Float64}       # xNew of current solout interval
    cont_i::Vector{FInt}          # argument to contd5/contd8
    cont_s::Vector{Float64}       # argument to contd5/contd8
    cont_con::Ptr{Float64}          # saved pointers for contd5/contd8
    cont_icomp::Ptr{FInt}             # saved pointers for contd5/contd8
    cont_nd::Ptr{FInt}             # saved pointers for contd5/contd8
end

"""
     mutable struct DopriArguments{FInt<:FortranInt} <:
              AbstractArgumentsODESolver{FInt}

Stores Arguments for Dopri solver.

FInt is the Integer type used for the fortran compilation.
"""
mutable struct DopriArguments{FInt <: FortranInt} <: AbstractArgumentsODESolver{FInt}
    N::Vector{FInt}      # Dimension
    FCN::Ptr{Cvoid}        # rhs callback
    t::Vector{Float64}   # start time (and current)
    tEnd::Vector{Float64}   # end time
    x::Vector{Float64}   # initial value (and current state)
    RTOL::Vector{Float64}   # relative tolerance
    ATOL::Vector{Float64}   # absolute tolerance
    ITOL::Vector{FInt}      # switch for RTOL, ATOL
    SOLOUT::Ptr{Cvoid}        # solout callback
    IOUT::Vector{FInt}      # switch for SOLOUT
    WORK::Vector{Float64}   # double working array
    LWORK::Vector{FInt}      # length of WORK
    IWORK::Vector{FInt}      # integer working array
    LIWORK::Vector{FInt}      # length of IWORK
    RPAR::Vector{Float64}   # add. double-array
    IPAR::Ref{DopriInternalCallInfos} # misuse IPAR
    IDID::Vector{FInt}      # Status code
    ## Allow uninitialized construction
    function DopriArguments{FInt}(dummy::FInt) where {FInt}
        return new{FInt}()
    end
end

"""
     function create_dopri_eval_sol_fcn_closure( cbi::CI, d::FInt,
             method_contd::Ptr{Cvoid}) where {FInt<:FortranInt,
                                             CI<:DopriInternalCallInfos}

generates a eval_sol_fcn for dopri5 and dop853.

Why is a closure needed? We need a function `eval_sol_fcn`
that calls `CONTD5_` or `CONTD8_` (with `ccall`).
But `CONTD?_` needs the information for the current state. This
information were saved by `unsafe_dopriSoloutCallback` in the
`DopriInternalCallInfos`. `eval_sol_fcn` needs to get this information.
Here comes `create_dopri_eval_sol_fcn_closure` into play: this function
takes the call-information and generates a `eval_sol_fcn` with this data.

Why doesn't `unsafe_dopriSoloutCallback` generate a closure (then
the current state needs not to be saved in `DopriInternalCallInfos`)?
Because then every call to `unsafe_dopriSoloutCallback` would have
generated a closure function. That's a lot of overhead: 1 closure function
for every solout call. With the strategy above, we have 1 closure function
per ODE-solver-call, i.e. 1 closure function per ODE.

For the typical calling sequence, see `DopriInternalCallInfos`.
"""
function create_dopri_eval_sol_fcn_closure(
        cbi::CI, d::FInt,
        method_contd::Ptr{Cvoid}
    ) where {
        FInt <: FortranInt,
        CI <: DopriInternalCallInfos,
    }

    function eval_sol_fcn_closure(s::Float64)
        (lio, l, lprefix) = (cbi.logio, cbi.loglevel, cbi.eval_lprefix)
        l_eval = l & LOG_EVALSOL > 0

        l_eval && println(lio, lprefix, "called with s=", s)
        cbi.cont_s[1] = s
        result = Vector{Float64}(undef, d)
        if s == cbi.tNew
            result[:] = cbi.xNew
            l_eval && println(lio, lprefix, "not calling contd because s==tNew")
        else
            for k in 1:d
                cbi.cont_i[1] = k
                result[k] = ccall(
                    method_contd, Float64,
                    (Ptr{FInt}, Ptr{Float64}, Ptr{Float64}, Ptr{FInt}, Ptr{FInt}),
                    cbi.cont_i, cbi.cont_s, cbi.cont_con, cbi.cont_icomp, cbi.cont_nd
                )
            end
        end

        l_eval && println(lio, lprefix, "contd returned ", result)
        return result
    end
    return eval_sol_fcn_closure
end

"""
     function unsafe_dopriSoloutCallback(
             nr_::Ptr{FInt}, told_::Ptr{Float64}, t_::Ptr{Float64},
             x_::Ptr{Float64}, n_::Ptr{FInt}, con_::Ptr{Float64},
             icomp_::Ptr{FInt}, nd_::Ptr{FInt}, rpar_::Ptr{Float64},
             cbi::CI, irtrn_::Ptr{FInt}) where {FInt<:FortranInt,
                                                CI<:DopriInternalCallInfos}

This is the solout given as callback to Fortran-dopri.

The `unsafe` prefix in the name indicates that no validations are
performed on the `Ptr`-pointers.

This function saves the state information of the solver in
`DopriInternalCallInfos`, where they can be found by
the `eval_sol_fcn`, see `create_dopri_eval_sol_fcn_closure`.

Then the user-supplied `output_fcn` is called (which in turn can use
`eval_sol_fcn`, to evaluate the solution at intermediate points).

The return value of the `output_fcn` is propagated to
`DOPRI5_` or `DOP853_`.

For the typical calling sequence, see `DopriInternalCallInfos`.
"""
function unsafe_dopriSoloutCallback(
        nr_::Ptr{FInt}, told_::Ptr{Float64}, t_::Ptr{Float64},
        x_::Ptr{Float64}, n_::Ptr{FInt}, con_::Ptr{Float64},
        icomp_::Ptr{FInt}, nd_::Ptr{FInt}, rpar_::Ptr{Float64},
        cbi::CI, irtrn_::Ptr{FInt}
    ) where {
        FInt <: FortranInt,
        CI <: DopriInternalCallInfos,
    }

    nr = unsafe_load(nr_); told = unsafe_load(told_); t = unsafe_load(t_)
    n = unsafe_load(n_)
    x = unsafe_wrap(Array, x_, (n,), own = false)
    irtrn = unsafe_wrap(Array, irtrn_, (1,), own = false)

    (lio, l, lprefix) = (cbi.logio, cbi.loglevel, cbi.out_lprefix)
    l_sol = l & LOG_SOLOUT > 0

    l_sol && println(
        lio, lprefix, "called with nr=", nr, " told=", told,
        " t=", t, " x=", x
    )

    cbi.tOld = told; cbi.tNew = t; cbi.xNew = x
    cbi.cont_con = con_; cbi.cont_icomp = icomp_; cbi.cont_nd = nd_
    cbi.output_data["nr"] = nr

    ret = call_julia_output_fcn(
        cbi, OUTPUTFCN_CALL_STEP, told, t, x,
        cbi.eval_sol_fcn
    )

    if ret == OUTPUTFCN_RET_STOP
        irtrn[1] = -1
    elseif ret == OUTPUTFCN_RET_CONTINUE
        irtrn[1] = 0
    elseif ret == OUTPUTFCN_RET_CONTINUE_XCHANGED
        irtrn[1] = 2
    else
        throw(InternalErrorODE(string("Unknown ret=", ret, " of output function")))
    end

    return nothing
end

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

"""
     function dopri_extract_commonOpt(
             t0::Real, T::Real, x0::Vector, opt::AbstractOptionsODE,
             args::DopriArguments{FInt}) where FInt<:FortranInt
           -> (d,nrdense,rhs_mode,output_mode,output_fcn)

calls solver_extract_commonOpt and additionally sets args.ITOL, args.IOUT
"""
function dopri_extract_commonOpt(
        t0::Real, T::Real, x0::Vector, opt::AbstractOptionsODE,
        args::DopriArguments{FInt}
    ) where {FInt <: FortranInt}

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

    args.ITOL = [scalarFlag ? 0 : 1]
    args.IOUT = [
        FInt(
            output_mode == OUTPUTFCN_NEVER ? 0 :
                (output_mode == OUTPUTFCN_DENSE ? 2 : 1)
        ),
    ]

    return (d, nrdense, rhs_mode, output_mode, output_fcn)
end


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