!
! Copyright (C) 2021, MaX CoE
! Distributed under the MIT License
! (license terms are at http://opensource.org/licenses/MIT).
!
!--
!
! Wrappers for selected Linear Algebra subroutines
!
#include<devxlib_defs.h>
#include<devxlib_macros.h>
!
#ifdef __DXL_HAVE_DEVICE
  !
  ! checks
  !
#if ! defined __DXL_CUBLAS && ! defined __DXL_ROCBLAS && ! defined __DXL_MKL_GPU
# error
#endif
#endif

submodule (devxlib_linalg) devxlib_linalg_gemv

   implicit none

   contains

   module subroutine dev_SGEMV_gpu(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      implicit none
      real(real32),  intent(in) TAR_ATTR :: ALPHA,BETA
      integer,   intent(in) :: M,N,LDA,INCX,INCY
      character, intent(in) :: TRANS
      real(real32),  intent(in) TAR_ATTR DEV_ATTR :: A(:,:),X(:)
      real(real32)              TAR_ATTR DEV_ATTR :: Y(:)
      !
#if defined __DXL_ROCBLAS
      integer(c_int) :: itrans
#else
      character(c_char) :: trans_
#endif
      integer :: ierr
      !
#if defined __DXL_ROCBLAS
      itrans = rocblas_get_operation(TRANS)
#else
      trans_=TRANS
#endif
      !
      call acc_loc_dev_sync()
      !
      !DEV_ACC data present(A,X,Y)
      !DEV_ACC host_data use_device(A,X,Y)
#if defined __DXL_CUBLAS
      call cublasSgemv(trans_,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#elif defined __DXL_ROCBLAS
      !DEV_OMPGPU target data use_device_ptr(A,X,Y)
      ierr=rocblas_sgemv(handle,itrans,M,N,c_loc(ALPHA),c_loc(A),LDA,c_loc(X),INCX,c_loc(BETA),c_loc(Y),INCY)
      !DEV_OMPGPU end target data
#elif defined __DXL_MKL_GPU
      !DEV_OMPGPU target data use_device_addr(A,X,Y)
      !DEV_OMPGPU dispatch
      call SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      !DEV_OMPGPU end dispatch
      !DEV_OMPGPU end target data
#else
      call SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#endif
      !DEV_ACC end host_data
      !DEV_ACC end data
      !
      call acc_loc_dev_sync()
      !
   end subroutine dev_SGEMV_gpu
   !
   module subroutine dev_DGEMV_gpu(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      implicit none
      real(real64),  intent(in) TAR_ATTR :: ALPHA,BETA
      integer,   intent(in) :: M,N,LDA,INCX,INCY
      character, intent(in) :: TRANS
      real(real64),  intent(in) TAR_ATTR DEV_ATTR :: A(:,:),X(:)
      real(real64)              TAR_ATTR DEV_ATTR :: Y(:)
      !
#if defined __DXL_ROCBLAS
      integer(c_int) :: itrans
#else
      character(c_char) :: trans_
#endif
      integer :: ierr
      !
#if defined __DXL_ROCBLAS
      itrans = rocblas_get_operation(TRANS)
#else
      trans_=TRANS
#endif
      !
      call acc_loc_dev_sync()
      !
      !DEV_ACC data present(A,X,Y)
      !DEV_ACC host_data use_device(A,X,Y)
#if defined __DXL_CUBLAS
      call cublasDgemv(trans_,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#elif defined __DXL_ROCBLAS
      !DEV_OMPGPU target data use_device_ptr(A,X,Y)
      ierr=rocblas_dgemv(handle,itrans,M,N,c_loc(ALPHA),c_loc(A),LDA,c_loc(X),INCX,c_loc(BETA),c_loc(Y),INCY)
      !DEV_OMPGPU end target data
#elif defined __DXL_MKL_GPU
      !DEV_OMPGPU target data use_device_addr(A,X,Y)
      !DEV_OMPGPU dispatch
      call DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      !DEV_OMPGPU end dispatch
      !DEV_OMPGPU end target data
#else
      call DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#endif
      !DEV_ACC end host_data
      !DEV_ACC end data
      !
      call acc_loc_dev_sync()
      !
   end subroutine dev_DGEMV_gpu
   !
   module subroutine dev_CGEMV_gpu(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      implicit none
      complex(real32), intent(in) TAR_ATTR :: ALPHA,BETA
      integer,     intent(in) :: M,N,LDA,INCX,INCY
      character,   intent(in) :: TRANS
      complex(real32), intent(in) TAR_ATTR DEV_ATTR :: A(:,:),X(:)
      complex(real32)             TAR_ATTR DEV_ATTR :: Y(:)
      !
#if defined __DXL_ROCBLAS
      integer(c_int) :: itrans
#else
      character(c_char) :: trans_
#endif
      integer :: ierr
      !
#if defined __DXL_ROCBLAS
      itrans = rocblas_get_operation(TRANS)
#else
      trans_=TRANS
#endif
      !
      call acc_loc_dev_sync()
      !
      !DEV_ACC data present(A,X,Y)
      !DEV_ACC host_data use_device(A,X,Y)
#if defined __DXL_CUBLAS
      call cublasCgemv(trans_,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#elif defined __DXL_ROCBLAS
      !DEV_OMPGPU target data use_device_ptr(A,X,Y)
      ierr=rocblas_cgemv(handle,itrans,M,N,c_loc(ALPHA),c_loc(A),LDA,c_loc(X),INCX,c_loc(BETA),c_loc(Y),INCY)
      !DEV_OMPGPU end target data
#elif defined __DXL_MKL_GPU
      !DEV_OMPGPU target data use_device_addr(A,X,Y)
      !DEV_OMPGPU dispatch
      call CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      !DEV_OMPGPU end dispatch
      !DEV_OMPGPU end target data
#else
      call CGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#endif
      !DEV_ACC end host_data
      !DEV_ACC end data
      !
      call acc_loc_dev_sync()
      !
   end subroutine dev_CGEMV_gpu
   !
   module subroutine dev_ZGEMV_gpu(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      implicit none
      complex(real64), intent(in) TAR_ATTR :: ALPHA,BETA
      integer,     intent(in) :: M,N,LDA,INCX,INCY
      character,   intent(in) :: TRANS
      complex(real64), intent(in) TAR_ATTR DEV_ATTR :: A(:,:),X(:)
      complex(real64)             TAR_ATTR DEV_ATTR :: Y(:)
      !
#if defined __DXL_ROCBLAS
      integer(c_int) :: itrans
#else
      character(c_char) :: trans_
#endif
      integer :: ierr
      !
#if defined __DXL_ROCBLAS
      itrans = rocblas_get_operation(TRANS)
#else
      trans_=TRANS
#endif
      !
      call acc_loc_dev_sync()
      !
      !DEV_ACC data present(A,X,Y)
      !DEV_ACC host_data use_device(A,X,Y)
#if defined __DXL_CUBLAS
      call cublasZgemv(trans_,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#elif defined __DXL_ROCBLAS
      !DEV_OMPGPU target data use_device_ptr(A,X,Y)
      ierr=rocblas_zgemv(handle,itrans,M,N,c_loc(ALPHA),c_loc(A),LDA,c_loc(X),INCX,c_loc(BETA),c_loc(Y),INCY)
      !DEV_OMPGPU end target data
#elif defined __DXL_MKL_GPU
      !DEV_OMPGPU target data use_device_addr(A,X,Y)
      !DEV_OMPGPU dispatch
      call ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
      !DEV_OMPGPU end dispatch
      !DEV_OMPGPU end target data
#else
      call ZGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY)
#endif
      !DEV_ACC end host_data
      !DEV_ACC end data
      !
      call acc_loc_dev_sync()
      !
   end subroutine dev_ZGEMV_gpu
   !
end submodule devxlib_linalg_gemv
