!  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 ChemShellCP2KModule

    use, intrinsic :: iso_c_binding
    use DL_PY2F
    use ChemShellParallelModule, only : chemsh_parallel

    private

    public register_cp2k, interface_cp2k, cp2k_wrap

!    type(dictType)  , pointer :: PyFrag, PyOptions
    type(dictType)    , pointer :: PyOptions

    integer(c_int)              :: c_debug
    integer(c_int)              :: cp2k_handle

    ! YL 06/03/2021: for gfortran-<9 theses pointers are not allowed to be
    !                initialised with => null()
    character(len=:)  , pointer :: ptr_input
    character(len=:)  , pointer :: ptr_output
    character(len=255)          :: cp2k_input, cp2k_output
    integer                     :: linput, loutput
    logical           , save    :: initialise = .true.

    contains

      
    subroutine register_cp2k(debug) bind(c, name="f_register_cp2k")

        integer(c_int), intent(in) :: debug

        type(c_funptr)             :: cp2k_pointer

        c_debug = debug

        cp2k_pointer = c_funloc(cp2k_wrap)
        cp2k_handle = chemsh_parallel%get_function_handle(cp2k_pointer)

    endsubroutine register_cp2k
    ! called by master process only
    integer(c_int) function interface_cp2k(fragPtr, optionsPtr) result(ierror) bind(c)
 
        implicit none
 
        type(PyType), intent(in) :: fragPtr
        type(PyType), intent(in) :: optionsPtr
 
        ierror = 1
 
        ! set up dict of Python objects
!        allocate(PyFrag   , source=ptr2dict(fragPtr))
        allocate(PyOptions, source=ptr2dict(optionsPtr))

        ! YL 01/03/2021: we only have one Python interpreter (master) within a workgroup so that
        !                these DL_PY2F operations are only done on the master; for using the values
        !                we still need to broadcast them to the replicas (see cp2k_wrap())
        cp2k_input  = repeat(' ', 255)
        cp2k_output = repeat(' ', 255)
        nullify(ptr_input, ptr_output)
        call PyOptions%get("input" , ptr_input)
        call PyOptions%get("output", ptr_output)
        ! the character pointers cannot be directed broadcast
        linput  = len(trim(ptr_input))
        loutput = len(trim(ptr_output))
        ! YL 03/03/2021: when compiled with ifort there are a lot of trailing symbles and
        !                we have to remove them cleanly; with gfortran we don't really need
        !                to do so
        cp2k_input (1:linput)  = ptr_input (1:linput)
        cp2k_output(1:loutput) = ptr_output(1:loutput)
 
        if (chemsh_parallel%is_parallel()) then
           call flush(6)
           ierror = chemsh_parallel%exec_function(cp2k_handle, c_debug)
        else
           ierror = cp2k_wrap()
        endif
 
        if(associated(PyOptions)) then
            call PyOptions%finalise()
            deallocate(PyOptions)
        endif

    endfunction interface_cp2k
    ! also called by replica processes
    integer function cp2k_wrap() result(ierror)

        use ChemShellParallelModule, only : chemsh_parallel

        implicit none

        integer(kind=4) :: communicator

        ierror = 1

        communicator = chemsh_parallel%comm_workgroup

        ! YL 01/03/2021: the replicas have known the character lengths yet
        ierror = chemsh_parallel%broadcast(linput , 1, 0)
        ierror = chemsh_parallel%broadcast(loutput, 1, 0)
        ! YL 01/03/2021: now we are ready to broadcast the filenames
        ierror = chemsh_parallel%broadcast(cp2k_input (1:linput ), linput , 0)
        ierror = chemsh_parallel%broadcast(cp2k_output(1:loutput), loutput, 0)
        call flush(6)
        call cp2k(cp2k_input(1:linput), cp2k_output(1:loutput), initialise, chemsh_parallel%is_root(), communicator)

        ! during a geometry optimisation or MD simulation we only initialise CP2K once
        initialise = .false.

        ierror = 0

    endfunction cp2k_wrap

endmodule ChemShellCP2KModule

