clblas.F90

Go to the documentation of this file.

!! Copyright (C) 2016 X. Andrade
!! Copyright (C) 2022 N. Tancogne-Dejean
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program 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 General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module clblas_oct_m
#ifdef HAVE_OPENCL
  use cl
#endif
 
  implicit none
 
  private
 
#ifdef HAVE_OPENCL
  public ::                  &
#ifdef HAVE_CLBLAS
    clblasgetversion,     &
    clblassetup,          &
    clblasteardown,       &
#endif
    clblasdtrsmex,        &
    clblasztrsmex,        &
    clblasdgemmex,        &
    clblaszgemmex,        &
    clblasdgemvex,        &
    clblaszgemvex,        &
    clblasdsyrkex,        &
    clblaszherkex,        &
    clblasddot,           &
    clblaszdotc,          &
    clblaszdotu,          &
    clblasdnrm2,          &
    clblasdznrm2
#endif
 
#ifdef HAVE_CLBLAS
  integer, public, parameter ::    &
    clblasRowMajor        = 0,     &
    clblascolumnmajor     = 1
 
  integer, public, parameter ::    &
    clblasNoTrans         = 0,     &
    clblastrans           = 1,     &
    clblasconjtrans       = 2
 
  integer, public, parameter ::    &
    clblasUpper           = 0,     &
    clblaslower           = 1
 
  integer, public, parameter ::    &
    clblasUnit            = 0,     &
    clblasnonunit         = 1
 
  integer, public, parameter ::    &
    clblasLeft            = 0,     &
    clblasright           = 1
#endif
 
#ifdef HAVE_CLBLAST
  integer, public, parameter ::    &
    clblasRowMajor        = 101,   &
    clblascolumnmajor     = 102
 
  integer, public, parameter ::    &
    clblasNoTrans         = 111,   &
    clblastrans           = 112,   &
    clblasconjtrans       = 113
 
  integer, public, parameter ::    &
    clblasUpper           = 121,   &
    clblaslower           = 122
 
  integer, public, parameter ::    &
    clblasUnit            = 132,   &
    clblasnonunit         = 131
 
  integer, public, parameter ::    &
    clblasLeft            = 141,   &
    clblasright           = 142
#endif
 
#if defined(HAVE_CLBLAS) || defined(HAVE_CLBLAST)
  integer, public, parameter ::                                  &
    clblasSuccess               = cl_success,                 &
    clblasinvalidvalue          = cl_invalid_value,           &
    clblasinvalidcommandqueue   = cl_invalid_command_queue,   &
    clblasinvalidcontext        = cl_invalid_context,         &
    clblasinvalidmemobject      = cl_invalid_mem_object,      &
    clblasinvaliddevice         = cl_invalid_device,          &
    clblasinvalideventwaitlist  = cl_invalid_event_wait_list, &
    clblasoutofresources        = cl_out_of_resources,        &
    clblasoutofhostmemory       = cl_out_of_host_memory,      &
    clblasinvalidoperation      = cl_invalid_operation,       &
    clblascompilernotavailable  = cl_compiler_not_available,  &
    clblasbuildprogramfailure   = cl_build_program_failure
 
  integer, public, parameter ::             &
    clblasNotImplemented        = -1024, &
    clblasnotinitialized        = -1023, &
    clblasinvalidmata           = -1022, &
    clblasinvalidmatb           = -1021, &
    clblasinvalidmatc           = -1020, &
    clblasinvalidvecx           = -1019, &
    clblasinvalidvecy           = -1018, &
    clblasinvaliddim            = -1017, &
    clblasinvalidleaddima       = -1016, &
    clblasinvalidleaddimb       = -1015, &
    clblasinvalidleaddimc       = -1014, &
    clblasinvalidincx           = -1013, &
    clblasinvalidincy           = -1012, &
    clblasinsufficientmemmata   = -1011, &
    clblasinsufficientmemmatb   = -1010, &
    clblasinsufficientmemmatc   = -1009, &
    clblasinsufficientmemvecx   = -1008, &
    clblasinsufficientmemvecy   = -1007
 
  ! Custom additional status codes for CLBlast
  integer, public, parameter ::               &
    clblastInsufficientMemoryTemp    = -2050, &! Temporary buffer provided to GEMM routine is too small
    clblastinvalidbatchcount         = -2049, &! The batch count needs to be positive
    clblastinvalidoverridekernel     = -2048, &! Trying to override parameters for an invalid kernel
    clblastmissingoverrideparameter  = -2047, &! Missing override parameter(s) for the target kernel
    clblastinvalidlocalmemusage      = -2046, &! Not enough local memory available on this device
    clblastnohalfprecision           = -2045, &! Half precision (16-bits) not supported by the device
    clblastnodoubleprecision         = -2044, &! Double precision (64-bits) not supported by the device
    clblastinvalidvectorscalar       = -2043, &! The unit-sized vector is not a valid OpenCL buffer
    clblastinsufficientmemoryscalar  = -2042, &! The unit-sized vector`s OpenCL buffer is too small
    clblastdatabaseerror             = -2041, &! Entry for the device was not found in the database
    clblastunknownerror              = -2040, &! A catch-all error code representing an unspecified error
    clblastunexpectederror           = -2039   ! A catch-all error code representing an unexpected exception
#endif
 
  ! SUPPORT FUNCTIONS
 
#ifdef HAVE_CLBLAS
  interface clblasgetversion
    subroutine clblasgetversion_low(major, minor, patch, status)
      implicit none
 
      integer, intent(out) :: major
      integer, intent(out) :: minor
      integer, intent(out) :: patch
      integer, intent(out) :: status
    end subroutine clblasgetversion_low
  end interface clblasgetversion
 
  interface clblassetup
    subroutine clblassetup_low(status)
      implicit none
 
      integer, intent(out) :: status
    end subroutine clblassetup_low
  end interface clblassetup
 
  interface clblasteardown
    subroutine clblasteardown_low()
    end subroutine clblasteardown_low
  end interface clblasteardown
#endif
 
 
#if defined(HAVE_CLBLAS) || defined(HAVE_CLBLAST)
  ! -------------------------------------------------
 
  interface clblasdtrsmex
    subroutine clblasdtrsmex_low(order, side, uplo, transA, diag, M, N, alpha, A, offA, lda, B, offB, ldb, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: side
      integer,                intent(in)    :: uplo
      integer,                intent(in)    :: transa
      integer,                intent(in)    :: diag
      integer(8),             intent(in)    :: m
      integer(8),             intent(in)    :: n
      real(8),                intent(in)    :: alpha
      type(cl_mem),           intent(inout) :: a
      integer(8),             intent(in)    :: offa
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(inout) :: b
      integer(8),             intent(in)    :: offb
      integer(8),             intent(in)    :: ldb
      type(cl_command_queue), intent(inout) :: commandqueue
      integer,                intent(out)   :: status
    end subroutine clblasdtrsmex_low
  end interface clblasdtrsmex
 
  ! -------------------------------------------------
 
  interface clblasztrsmex
    subroutine clblasztrsmex_low(order, side, uplo, transA, diag, M, N, alpha, A, offA, lda, B, offB, ldb, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: side
      integer,                intent(in)    :: uplo
      integer,                intent(in)    :: transa
      integer,                intent(in)    :: diag
      integer(8),             intent(in)    :: m
      integer(8),             intent(in)    :: n
      complex(8),             intent(in)    :: alpha
      type(cl_mem),           intent(inout) :: a
      integer(8),             intent(in)    :: offa
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(inout) :: b
      integer(8),             intent(in)    :: offb
      integer(8),             intent(in)    :: ldb
      type(cl_command_queue), intent(inout) :: commandqueue
      integer,                intent(out)   :: status
    end subroutine clblasztrsmex_low
  end interface clblasztrsmex
 
  ! -------------------------------------------------
 
  interface clblasdgemvex
    subroutine clblasdgemvex_low(order, transA, M, N, &
      alpha, A, offA, lda, X, offX, incx, beta, Y, offY, incy, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: transa
      integer(8),             intent(in)    :: m
      integer(8),             intent(in)    :: N
      real(8),                intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer(8),             intent(in)    :: incx
      real(8),                intent(in)    :: beta
      type(cl_mem),           intent(inout) :: Y
      integer(8),             intent(in)    :: offY
      integer(8),             intent(in)    :: incy
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasdgemvex_low
  end interface clblasdgemvex
 
  ! -------------------------------------------------
 
  interface clblaszgemvex
    subroutine clblaszgemvex_low(order, transA, M, N, &
      alpha, A, offA, lda, X, offX, incx, beta, Y, offY, incy, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: transA
      integer(8),             intent(in)    :: M
      integer(8),             intent(in)    :: N
      complex(8),             intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer(8),             intent(in)    :: incx
      complex(8),             intent(in)    :: beta
      type(cl_mem),           intent(inout) :: Y
      integer(8),             intent(in)    :: offY
      integer(8),             intent(in)    :: incy
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblaszgemvex_low
  end interface clblaszgemvex
 
 
  ! -------------------------------------------------
 
  interface clblasdgemmex
    subroutine clblasdgemmex_low(order, transA, transB, M, N, K, &
      alpha, A, offA, lda, B, offB, ldb, beta, C, offC, ldc, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: transA
      integer,                intent(in)    :: transB
      integer(8),             intent(in)    :: M
      integer(8),             intent(in)    :: N
      integer(8),             intent(in)    :: K
      real(8),                intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(in)    :: B
      integer(8),             intent(in)    :: offB
      integer(8),             intent(in)    :: ldb
      real(8),                intent(in)    :: beta
      type(cl_mem),           intent(inout) :: C
      integer(8),             intent(in)    :: offC
      integer(8),             intent(in)    :: ldc
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasdgemmex_low
  end interface clblasdgemmex
 
  ! -------------------------------------------------
 
  interface clblaszgemmex
    subroutine clblaszgemmex_low(order, transA, transB, M, N, K, &
      alpha, A, offA, lda, B, offB, ldb, beta, C, offC, ldc, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: transA
      integer,                intent(in)    :: transB
      integer(8),             intent(in)    :: M
      integer(8),             intent(in)    :: N
      integer(8),             intent(in)    :: K
      complex(8),             intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      type(cl_mem),           intent(in)    :: B
      integer(8),             intent(in)    :: offB
      integer(8),             intent(in)    :: ldb
      complex(8),             intent(in)    :: beta
      type(cl_mem),           intent(inout) :: C
      integer(8),             intent(in)    :: offC
      integer(8),             intent(in)    :: ldc
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblaszgemmex_low
  end interface clblaszgemmex
 
  ! -------------------------------------------------
 
  interface clblasdsyrkex
    subroutine clblasdsyrkex_low(order, uplo, transA, N, K, &
      alpha, A, offA, lda, beta, C, offC, ldc, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: uplo
      integer,                intent(in)    :: transA
      integer(8),             intent(in)    :: N
      integer(8),             intent(in)    :: K
      real(8),                intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      real(8),                intent(in)    :: beta
      type(cl_mem),           intent(inout) :: C
      integer(8),             intent(in)    :: offC
      integer(8),             intent(in)    :: ldc
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasdsyrkex_low
  end interface clblasdsyrkex
  ! -------------------------------------------------
 
  interface clblaszherkex
    subroutine clblaszherkex_low(order, uplo, transA, N, K, &
      alpha, A, offA, lda, beta, C, offC, ldc, commandQueue, status)
      use cl
 
      implicit none
 
      integer,                intent(in)    :: order
      integer,                intent(in)    :: uplo
      integer,                intent(in)    :: transA
      integer(8),             intent(in)    :: N
      integer(8),             intent(in)    :: K
      real(8),                intent(in)    :: alpha
      type(cl_mem),           intent(in)    :: A
      integer(8),             intent(in)    :: offA
      integer(8),             intent(in)    :: lda
      real(8),                intent(in)    :: beta
      type(cl_mem),           intent(inout) :: C
      integer(8),             intent(in)    :: offC
      integer(8),             intent(in)    :: ldc
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblaszherkex_low
  end interface clblaszherkex
 
 
  ! --------------------------------------------------
 
  interface clblasddot
    subroutine clblasddot_low(N, dotProduct, offDP, X, offx, incx, Y, offY, incy, scratchBuff, CommandQueue, status)
      use cl
 
      implicit none
 
      integer(8),             intent(in)    :: N
      type(cl_mem),           intent(inout) :: dotProduct
      integer(8),             intent(in)    :: offDP
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer,                intent(in)    :: incx
      type(cl_mem),           intent(in)    :: Y
      integer(8),             intent(in)    :: offy
      integer,                intent(in)    :: incy
      type(cl_mem),           intent(inout) :: scratchBuff
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasddot_low
  end interface clblasddot
 
 
  ! --------------------------------------------------
 
  interface clblaszdotc
    subroutine clblaszdotc_low(N, dotProduct, offDP, X, offx, incx, Y, offY, incy, scratchBuff, CommandQueue, status)
      use cl
 
      implicit none
 
      integer(8),             intent(in)    :: N
      type(cl_mem),           intent(inout) :: dotProduct
      integer(8),             intent(in)    :: offDP
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer,                intent(in)    :: incx
      type(cl_mem),           intent(in)    :: Y
      integer(8),             intent(in)    :: offy
      integer,                intent(in)    :: incy
      type(cl_mem),           intent(inout) :: scratchBuff
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblaszdotc_low
  end interface clblaszdotc
 
  ! --------------------------------------------------
 
  interface clblaszdotu
    subroutine clblaszdotu_low(N, dotProduct, offDP, X, offx, incx, Y, offY, incy, scratchBuff, CommandQueue, status)
      use cl
 
      implicit none
 
      integer(8),             intent(in)    :: N
      type(cl_mem),           intent(inout) :: dotProduct
      integer(8),             intent(in)    :: offDP
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer,                intent(in)    :: incx
      type(cl_mem),           intent(in)    :: Y
      integer(8),             intent(in)    :: offy
      integer,                intent(in)    :: incy
      type(cl_mem),           intent(inout) :: scratchBuff
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblaszdotu_low
  end interface clblaszdotu
 
 
  ! --------------------------------------------------
 
  interface clblasdnrm2
    subroutine clblasdnrm2_low(N, NRM2, offNRM2, X, offx, incx, scratchBuff, CommandQueue, status)
      use cl
 
      implicit none
 
      integer(8),             intent(in)    :: N
      type(cl_mem),           intent(inout) :: NRM2
      integer(8),             intent(in)    :: offNRM2
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer,                intent(in)    :: incx
      type(cl_mem),           intent(inout) :: scratchBuff
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasdnrm2_low
  end interface clblasdnrm2
 
  ! --------------------------------------------------
 
  interface clblasdznrm2
    subroutine clblasdznrm2_low(N, NRM2, offNRM2, X, offx, incx, scratchBuff, CommandQueue, status)
      use cl
 
      implicit none
 
      integer(8),             intent(in)    :: N
      type(cl_mem),           intent(inout) :: NRM2
      integer(8),             intent(in)    :: offNRM2
      type(cl_mem),           intent(in)    :: X
      integer(8),             intent(in)    :: offX
      integer,                intent(in)    :: incx
      type(cl_mem),           intent(inout) :: scratchBuff
      type(cl_command_queue), intent(inout) :: CommandQueue
      integer,                intent(out)   :: status
    end subroutine clblasdznrm2_low
  end interface clblasdznrm2
 
#endif
 
end module clblas_oct_m