!
! Copyright (C) 2021, MaX CoE
! Distributed under the MIT License
! (license terms are at http://opensource.org/licenses/MIT).
!
!--
!
! Definitions and utilities to handle async_id, which maps
! to CUDA stream (when using DXL_CUF), or OpenACC queues
!
#include<devxlib_defs.h>

module devxlib_async

   use iso_c_binding,       only : c_int, c_intptr_t
   use devxlib_environment, only : devxlib_error
   !
#if defined __DXL_CUDAF
   use cudafor
#elif defined __DXL_OPENACC
   use openacc
   use devxlib_environment, only : cudaStreamSynchronize, cudaDeviceSynchronize,&
                                   acc_get_cuda_stream_f
#endif
   !
   implicit none
   private
   !
   ! In the following dxl_async_kind is meant to represent
   ! - CUDA Streams    if CUDAF is used
   ! - ApenACC Queues  id OPENACC is used
   !
#if defined __DXL_CUDAF
   integer, parameter :: dxl_async_kind  = cuda_Stream_Kind
   integer, parameter :: dxl_stream_kind = cuda_Stream_Kind
#elif defined __DXL_OPENACC
   integer, parameter :: dxl_async_kind  = kind(acc_async_noval)
   integer, parameter :: dxl_stream_kind = c_intptr_t
#else
   integer, parameter :: dxl_async_kind  = kind(0)
   integer, parameter :: dxl_stream_kind = c_intptr_t
#endif
   !
   public :: dxl_async_kind 
   public :: dxl_stream_kind 
   public :: devxlib_async_create
   public :: devxlib_async_synchronize
   public :: devxlib_async2stream
   public :: devxlib_device_sync

contains

      subroutine devxlib_async_create(async_id,val,default_async)
         implicit none
         integer(kind=dxl_async_kind),        intent(inout) :: async_id
         integer(kind=dxl_async_kind), optional, intent(in) :: val 
         logical,                      optional, intent(in) :: default_async
         !   
         integer :: ierr
         logical :: set_default_async
         !   
         ierr=0
         async_id=0
         set_default_async=.false.
         if (present(default_async)) set_default_async=default_async
         !   
#if defined __DXL_CUDAF
         if (set_default_async) then
            async_id=cudaforGetDefaultStream()
         else if (present(val)) then
            async_id=val
         else
            !ierr = CudaStreamCreate(async_id)
            ierr = CudaStreamCreateWithFlags(async_id,cudaStreamNonBlocking)
         endif
         !
#elif defined __DXL_OPENACC
         if (set_default_async) then
            async_id=acc_async_sync
         else if (present(val)) then
            async_id=val
         else
            call devxlib_error("devxlib_async_create","unable to create queue",1)
         endif
#endif
         return
      end subroutine devxlib_async_create
      !
      !
      subroutine devxlib_async_synchronize(async_id)
         implicit none
         integer(kind=dxl_async_kind), intent(in) :: async_id
         integer :: ierr
         !   
         ierr=0
#if defined __DXL_CUDAF
         ierr = CudaStreamSynchronize(async_id)
#elif defined __DXL_OPENACC
         !DEV_ACC wait(async_id)
         !!call acc_wait(async_id)
#endif
         return
      end subroutine devxlib_async_synchronize
      !
      !
      function devxlib_async2stream(async_id) result(stream)
         implicit none
         integer(kind=dxl_async_kind), intent(in) :: async_id
         integer(kind=dxl_stream_kind) :: stream
         !
         stream=0
#if defined __DXL_CUDAF
         stream=async_id
#elif defined __DXL_OPENACC
#  if defined __PGI
         ! acc_get_cuda_stream not defined eg by GNU compilers
         stream=acc_get_cuda_stream(async_id)
#  else
         ! replace with hand-made c-binding interface
         stream=int( acc_get_cuda_stream_f(async_id), kind=dxl_stream_kind )
         !
         ! incorrect place-holder
         !stream=int(async_id,kind=dxl_stream_kind)
#  endif
#endif
         return
      end function devxlib_async2stream
      !
      !
      function devxlib_device_sync() result(ierr)
         implicit none
         integer :: ierr 
         !   
         ierr=0
#if defined __DXL_CUDAF
         ierr = CudaDeviceSynchronize()
#elif defined __DXL_OPENACC
         ierr = CudaDeviceSynchronize()
#endif
      end function devxlib_device_sync

end module devxlib_async

