!  Copyright (C) 2017 The authors of Py-ChemShell
!
!  This file is part of Py-ChemShell.
!
!  Py-ChemShell is free software: you can redistribute it and/or modify
!  it under the terms of the GNU Lesser General Public License as
!  published by the Free Software Foundation, either version 3 of the
!  License, or (at your option) any later version.
!
!  Py-ChemShell is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU Lesser General Public License for more details.
!
!  You should have received a copy of the GNU Lesser General Public
!  License along with Py-ChemShell.  If not, see
!  <http://www.gnu.org/licenses/>.

module ChemShellDLFModule

    use, intrinsic :: iso_c_binding
    use DL_PY2F
    use dlf_parameter_module, only: rk
    use dlf_convergence     , only: valg, valrmsg, vals, valrmss

    private
    public interface_dlf, PyFrag, PyFrag2, PyResult
    public PyOptions, PyCallback, PySetParams
!, PyGetGrads
    public ierror

! YL: since Intel Compiler 2016, "external" is no longer allowed to be bind(c)
!     "error #8809: An OPTIONAL or EXTERNAL dummy argument to a BIND(C) procedure is not interoperable"
!    integer(c_long), pointer, external :: PyCallback
    abstract interface
        integer(c_long) function callback() bind(c)
            use iso_c_binding
        endfunction callback
        real(c_double) function objective() bind(c)
            use iso_c_binding
        endfunction objective
        integer(c_long) function setParams() bind(c)
            use iso_c_binding
        endfunction setParams
! YL 26/01/2021: unified the both callback functions for parameterisation and geometry otimisation to callback()
!        integer(c_long) function getGrads() bind(c)
!            use iso_c_binding
!        endfunction getGrads
    endinterface

    type(dictType)      , pointer :: PyFrag, PyFrag2, PyResult, PyOptions
    procedure(callback) , pointer :: PyCallback
    procedure(setParams), pointer :: PySetParams
!    procedure(getGrads) , pointer :: PyGetGrads
    integer                      :: ierror

    contains

!        function interface_dlf(nvarin, nvarin2, nspec, theoryPtr, fragPtr, resultPtr, optionsPtr, callbackPtr) bind(c) result(ireturn)
        function interface_dlf(nvarin, nvarin2, nspec, theoryPtr, fragPtr, resultPtr, optionsPtr) bind(c) result(ireturn)

            implicit none
    
            integer(c_long)           , intent(in) :: nvarin
            integer(c_long)           , intent(in) :: nvarin2
            integer(c_long)           , intent(in) :: nspec
            type(PyType)              , intent(in) :: theoryPtr
            type(PyType)              , intent(in) :: fragPtr
            type(PyType)              , intent(in) :: resultPtr
            type(PyType)              , intent(in) :: optionsPtr
!            type(c_funptr)            , intent(in) :: callbackPtr
    
            type(PyType)   , pointer               :: frag2Ptr
            integer(c_long), parameter             :: master = 1
            integer(c_int)                         :: ireturn

            ! if pyfuncPtr is a pointer GNU segfaults at runtime while Intel does not
            type(c_funptr)                         :: pyfuncPtr

            logical                                :: parameterise
            integer                                :: iparameterise
            real(rk)                               :: energy(1)

            allocate(PyFrag   , source=ptr2dict(fragPtr))
            allocate(PyResult , source=ptr2dict(resultPtr))
            allocate(PyOptions, source=ptr2dict(optionsPtr))
    
            ! callback function to calculate the gradients
            ! YL 26/01/2021: no longer needed as the pointer to the callback function is passed via PyOptions
!            call c_f_procpointer(callbackPtr, PyCallback)
            call PyOptions%get('callback', pyfuncPtr)
            call c_f_procpointer(pyfuncPtr, PyCallback)

            call PyOptions%get("parameterise", iparameterise)
            parameterise = iparameterise.eq.1

            ! atomistic mode
            if(.not.parameterise) then
                ! could be moved to dlf_get_parameters(), however will be difficult to deallocate
                call PyOptions%get('frag2', frag2Ptr)

                if(associated(frag2Ptr)) then
                    allocate(PyFrag2, source=ptr2dict(frag2Ptr))
                endif

            ! parameter mode
            else

                ! objective function
!                call PyOptions%get('objfunc', pyfuncPtr)
!                if(associated(pyfuncPtr)) then
!                call c_f_procpointer(pyfuncPtr, PyObjFunc)
!                endif
    
                ! function to set the parameter values
                call PyOptions%get('setParameters', pyfuncPtr)
!                if(associated(pyfuncPtr)) then
                call c_f_procpointer(pyfuncPtr, PySetParams)
!                endif
    
            endif

            call dlf_mpi_initialize

            call dl_find(nvarin, nvarin2, nspec, master)

            ! save the final energy, max grad, max step, RMS grad, RMS step
            ! this is the only place where we can get the information because no method of dlf_routines.f90 is called when DL_FIND converges
            call PyResult%get('energy', energy)
            call PyResult%set('convergences', (/energy(1),valg,vals,valrmsg,valrmss/))
    
            if(associated(PyFrag)) then
                call PyFrag%finalise()
                deallocate(PyFrag)
            endif
            if(associated(PyResult)) then
                call PyResult%finalise()
                deallocate(PyResult)
            endif
            if(associated(PyOptions)) then
                call PyOptions%finalise()
                deallocate(PyOptions)
            endif
            if(associated(PyFrag2)) then
                call PyFrag2%finalise()
                deallocate(PyFrag2)
            endif

            ireturn = ierror 
    
        endfunction interface_dlf

endmodule ChemShellDLFModule


