!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!                                                                      *
! Copyright (C) 2015, Steven Vancoillie                                *
!***********************************************************************
! Molcas task manager
! Steven Vancoillie, June 2015
!   Reimplementation of the task manager routines
!   based solely on atomic read+increment operations on
!   a global task counter.
!
!   For GA, we use the ga_read_inc function, and for DGA
!   we use the gtsk_nxtval function. The latter has a special
!   "gtsk_nxtval_even" sibling for better performance. It is
!   only used when both MPI and DGA are active. The routines
!   that use this special flavour can be found in the second
!   part of the file.
!
!   The task lists are stacked, and have to be freed in
!   the order of last initialized = freed first!

module Task_Manager

#ifdef _MOLCAS_MPP_
use Para_Info, only: Is_Real_Par
use GA_Wrapper, only: GA_Create, GA_Destroy, GA_Read_Inc, MT_INT
#endif
use Definitions, only: iwp

implicit none
private

integer(kind=iwp), parameter :: mxtsklst = 4
integer(kind=iwp) :: list_counter = 0, ntasks(mxtsklst), task_counter(mxtsklst)

public :: free_tsk, free_tsk_even, init_tsk, init_tsk_even, rsv_tsk, rsv_tsk_even

contains

subroutine init_tsk(id,n)

  integer(kind=iwp), intent(out) :: id
  integer(kind=iwp), intent(in) :: n

  if (list_counter == mxtsklst) call sysabendmsg('init_tsk','no free task lists available',' ')
  list_counter = list_counter+1

  id = list_counter
  ntasks(id) = n
# ifdef _MOLCAS_MPP_
  if (is_real_par()) then
    if (.not. ga_create(MT_INT,1,1,'gltskl',0,0,task_counter(id))) &
      call sysabendmsg('init_tsk','failed to create global task list',' ')
#   ifdef _GA_
    call ga_fill(task_counter(id),1)
#   else
    call ga_zero(task_counter(id))
    call gtsk_setup(id,task_counter(id))
#   endif
  else
    task_counter(id) = 1
  end if
# else
  task_counter(id) = 1
# endif

end subroutine init_tsk

subroutine free_tsk(id)

  integer(kind=iwp), intent(in) :: id

  if (list_counter == 0) call sysabendmsg('free_tsk','attempting to free a non-existent task list.',' ')
  if (id /= list_counter) call sysabendmsg('free_tsk','only stack-based task lists are supported.',' ')
# ifdef _MOLCAS_MPP_
  if (is_real_par()) then
    if (.not. ga_destroy(task_counter(id))) call sysabendmsg('free_tsk','failed to destroy global task list.',' ')
#   ifndef _GA_
    call gtsk_reset(id)
#   endif
  end if
# endif
  list_counter = list_counter-1

end subroutine free_tsk

function rsv_tsk(id,task)

  logical(kind=iwp) :: rsv_tsk
  integer(kind=iwp), intent(in) :: id
  integer(kind=iwp), intent(out) :: task

# ifdef _MOLCAS_MPP_
  if (is_real_par()) then
    ! (atomically) read+increment next task number
#   ifdef _GA_
    task = ga_read_inc(task_counter(id),1,1,1)
#   else
    task = gtsk_nxtval(id,1)
#   endif
  else
    task = task_counter(id)
    task_counter(id) = task_counter(id)+1
  end if
# else
  task = task_counter(id)
  task_counter(id) = task_counter(id)+1
# endif
  rsv_tsk = task <= ntasks(id)

end function rsv_tsk

!****************************************************************
! The "even" flavour of the task routines just give each process
! a spread of numbers just as they would do with a loop stride.
!****************************************************************
subroutine init_tsk_even(id,n)

# ifdef _MOLCAS_MPP_
  use Para_Info, only: MyRank
# endif

  integer(kind=iwp), intent(out) :: id
  integer(kind=iwp), intent(in) :: n

  if (list_counter == mxtsklst) call sysabendmsg('init_tsk_even','no free task lists available',' ')
  list_counter = list_counter+1

  id = list_counter
  ntasks(id) = n
# ifdef _MOLCAS_MPP_
  if (is_real_par()) then
    task_counter(id) = myrank+1
  else
    task_counter(id) = 1
  end if
# else
  task_counter(id) = 1
# endif

end subroutine init_tsk_even

subroutine free_tsk_even(id)

  integer(kind=iwp), intent(in) :: id

  if (list_counter == 0) call sysabendmsg('free_tsk_even','attempting to free a non-existent task list.',' ')
  if (id /= list_counter) call sysabendmsg('free_tsk_even','only stack-based task lists are supported.',' ')
  list_counter = list_counter-1

end subroutine free_tsk_even

function rsv_tsk_even(id,task)

# ifdef _MOLCAS_MPP_
  use Para_Info, only: nProcs
# endif

  logical(kind=iwp) :: rsv_tsk_even
  integer(kind=iwp), intent(in) :: id
  integer(kind=iwp), intent(out) :: task

# ifdef _MOLCAS_MPP_
  if (is_real_par()) then
    task = task_counter(id)
    ! the next task is a stride of <nprocs> away
    task_counter(id) = task_counter(id)+nprocs
  else
    task = task_counter(id)
    task_counter(id) = task_counter(id)+1
  end if
# else
  task = task_counter(id)
  task_counter(id) = task_counter(id)+1
# endif
  rsv_tsk_even = task <= ntasks(id)

end function rsv_tsk_even

end module Task_Manager
