!  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/>.

! no MPI methods should appear here
module ChemShellGAModule

    use mpi

    implicit none

    private

    public :: GAType

    integer, parameter :: intType = sizeof(MPI_INTEGER)

    type GAType
        private
        integer(kind=intType), public :: debug
        integer(kind=intType), public :: ncolours
        integer(kind=intType), public :: nkeys
        integer(kind=intType), public :: colour
        integer(kind=intType), public :: comm_colour
        integer(kind=intType), public :: key
        contains
        procedure, public :: initialise
        procedure, public :: is_root
        procedure, public :: finalise    => private_dummy
        procedure, public :: synchronise => private_dummy
        procedure, public :: print       => private_function
        procedure, public :: summarise   => private_function
        procedure, private :: private_dummy
        procedure, private :: private_function
    endtype GAType
    contains
    integer(kind=intType) function initialise(this, ncolours, ga_memory, debug) result(ierror)

        implicit none

!        include 'mpif.h'

        class(GAType)        , intent(inout) :: this
        integer(kind=intType), intent(in)    :: ncolours
        integer(kind=intType), intent(in)    :: ga_memory
        integer(kind=intType), intent(in)    :: debug

        integer(kind=intType) :: rank, nprocs

        this%debug    = debug
        this%ncolours = ncolours

        call MPI_COMM_SIZE(MPI_COMM_WORLD, nprocs, ierror)
        call MPI_COMM_RANK(MPI_COMM_WORLD, rank  , ierror)

        ! TCS: WG_size
        if(mod(nprocs, ncolours).eq.0) then
            this%nkeys = nprocs/ncolours
        else
            print *, ">>> FATAL ERROR: number of processors (-np) not divisible by number of workgroups (-nwg)"
            stop
        endif

        ! TCS: myWorkgroup
        this%colour = rank/this%nkeys

        ! TCS: WG_proc
        this%key = mod(rank, this%nkeys)

    endfunction initialise
    logical function is_root(this) result(result)

        class(GAType), intent(in) :: this

        result = this%key.eq.0

    endfunction is_root
    subroutine private_dummy(this)

        class(GAType), intent(in) :: this

    endsubroutine private_dummy
    integer function private_function(this, arg) result(result)

        class(GAType), intent(in)           :: this
        class(*)     , intent(in), optional :: arg

        result = 0

    endfunction private_function

endmodule ChemShellGAModule
