accel_blas.F90

Go to the documentation of this file.

!! Copyright (C) 2016 X. Andrade
!!
!! 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 accel_blas_oct_m
  use accel_oct_m
#ifdef HAVE_CUDA
  use cuda_oct_m
#endif
  use debug_oct_m
  use global_oct_m
  use iso_c_binding
  use profiling_oct_m
  use types_oct_m
 
  implicit none
 
  private
 
  public ::                        &
    daccel_dot,                    &
    zaccel_dot,                    &
    daccel_dotu,                   &
    zaccel_dotu,                   &
    daccel_nrm2,                   &
    zaccel_nrm2,                   &
    daccel_herk,                   &
    zaccel_herk,                   &
    daccel_trsm,                   &
    zaccel_trsm,                   &
    daccel_gemm,                   &
    zaccel_gemm,                   &
    daccel_gemv,                   &
    zaccel_gemv
 
#if defined(HAVE_CUDA)
  integer, parameter, public ::                      &
    ACCEL_BLAS_LEFT  = cublas_side_left,             &
    accel_blas_right = cublas_side_right
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_LOWER = cublas_fill_mode_lower,       &
    accel_blas_upper = cublas_fill_mode_upper
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_N = cublas_op_n,                      &
    accel_blas_t = cublas_op_t,                      &
    accel_blas_c = cublas_op_c
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_DIAG_NON_UNIT = cublas_diag_non_unit, &
    accel_blas_diag_unit     = cublas_diag_unit
#else
  integer, parameter, public ::                      &
    ACCEL_BLAS_LEFT  = 0,                            &
    accel_blas_right = 1
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_LOWER = 0,                            &
    accel_blas_upper = 1
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_N = 0,                      &
    accel_blas_t = 1,                      &
    accel_blas_c = 2
 
  integer, parameter, public ::                      &
    ACCEL_BLAS_DIAG_NON_UNIT = 0, &
    accel_blas_diag_unit     = 1
 
#endif
 
  ! DOT
  interface
    subroutine cuda_blas_ddot(n, x, offx, incx, y, offy, incy, res, offres) bind(c, name="oct_cuda_blas_ddot")
      use iso_c_binding
      implicit none
 
      integer(c_int64_t), intent(in)    :: n
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: offx
      integer(c_int64_t), intent(in)    :: incx
      type(c_ptr),        intent(in)    :: y
      integer(c_int64_t), intent(in)    :: offy
      integer(c_int64_t), intent(in)    :: incy
      type(c_ptr),        intent(inout) :: res
      integer(c_int64_t), intent(in)    :: offres
    end subroutine cuda_blas_ddot
 
    subroutine cuda_blas_zdotc(n, x, offx, incx, y, offy, incy, res, offres) bind(c, name="oct_cuda_blas_zdotc")
      use iso_c_binding
      implicit none
 
      integer(c_int64_t), intent(in)    :: n
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: offx
      integer(c_int64_t), intent(in)    :: incx
      type(c_ptr),        intent(in)    :: y
      integer(c_int64_t), intent(in)    :: offy
      integer(c_int64_t), intent(in)    :: incy
      type(c_ptr),        intent(inout) :: res
      integer(c_int64_t), intent(in)    :: offres
    end subroutine cuda_blas_zdotc
 
    subroutine cuda_blas_zdotu(n, x, offx, incx, y, offy, incy, res, offres) bind(c, name="oct_cuda_blas_zdotu")
      use iso_c_binding
      implicit none
 
      integer(c_int64_t), intent(in)    :: n
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: offx
      integer(c_int64_t), intent(in)    :: incx
      type(c_ptr),        intent(in)    :: y
      integer(c_int64_t), intent(in)    :: offy
      integer(c_int64_t), intent(in)    :: incy
      type(c_ptr),        intent(inout) :: res
      integer(c_int64_t), intent(in)    :: offres
    end subroutine cuda_blas_zdotu
  end interface
 
  ! NRM2
  interface
    subroutine cuda_blas_dnrm2(n, x, offx, incx, res, offres) bind(c, name="oct_cuda_blas_dnrm2")
      use iso_c_binding
      implicit none
 
      integer(c_int64_t), intent(in)    :: n
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: offx
      integer(c_int64_t), intent(in)    :: incx
      type(c_ptr),        intent(inout) :: res
      integer(c_int64_t), intent(in)    :: offres
    end subroutine cuda_blas_dnrm2
 
    subroutine cuda_blas_znrm2(n, x, offx, incx, res, offres) bind(c, name="oct_cuda_blas_znrm2")
      use iso_c_binding
      implicit none
 
      integer(c_int64_t), intent(in)    :: n
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: offx
      integer(c_int64_t), intent(in)    :: incx
      type(c_ptr),        intent(inout) :: res
      integer(c_int64_t), intent(in)    :: offres
    end subroutine cuda_blas_znrm2
  end interface
 
  ! GEMM
  interface
    subroutine cuda_blas_dgemm(transa, transb, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc) &
      bind(c, name="oct_cuda_blas_dgemm")
      use iso_c_binding
      implicit none
 
      integer(c_int),     intent(in)    :: transa
      integer(c_int),     intent(in)    :: transb
      integer(c_int64_t), intent(in)    :: m
      integer(c_int64_t), intent(in)    :: n
      integer(c_int64_t), intent(in)    :: k
      real(c_double),     intent(in)    :: alpha
      type(c_ptr),        intent(in)    :: A
      integer(c_int64_t), intent(in)    :: lda
      type(c_ptr),        intent(in)    :: B
      integer(c_int64_t), intent(in)    :: ldb
      real(c_double),     intent(in)    :: beta
      type(c_ptr),        intent(inout) :: C
      integer(c_int64_t), intent(in)    :: ldc
    end subroutine cuda_blas_dgemm
 
    subroutine cuda_blas_zgemm(transa, transb, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc) &
      bind(c, name="oct_cuda_blas_zgemm")
      use iso_c_binding
      implicit none
 
      integer(c_int),            intent(in)    :: transa
      integer(c_int),            intent(in)    :: transb
      integer(c_int64_t),        intent(in)    :: m
      integer(c_int64_t),        intent(in)    :: n
      integer(c_int64_t),        intent(in)    :: k
      complex(c_double_complex), intent(in)    :: alpha
      type(c_ptr),               intent(in)    :: A
      integer(c_int64_t),        intent(in)    :: lda
      type(c_ptr),               intent(in)    :: B
      integer(c_int64_t),        intent(in)    :: ldb
      complex(c_double_complex), intent(in)    :: beta
      type(c_ptr),               intent(inout) :: C
      integer(c_int64_t),        intent(in)    :: ldc
    end subroutine cuda_blas_zgemm
  end interface
 
 
  ! GEMV
  interface
    subroutine cuda_blas_dgemv(transa, m, n, alpha, A, lda, x, incx, beta, y, incy) &
      bind(c, name="oct_cuda_blas_dgemv")
      use iso_c_binding
      implicit none
 
      integer(c_int),     intent(in)    :: transa
      integer(c_int64_t), intent(in)    :: m
      integer(c_int64_t), intent(in)    :: n
      real(c_double),     intent(in)    :: alpha
      type(c_ptr),        intent(in)    :: A
      integer(c_int64_t), intent(in)    :: lda
      type(c_ptr),        intent(in)    :: x
      integer(c_int64_t), intent(in)    :: incx
      real(c_double),     intent(in)    :: beta
      type(c_ptr),        intent(inout) :: y
      integer(c_int64_t), intent(in)    :: incy
    end subroutine cuda_blas_dgemv
 
    subroutine cuda_blas_zgemv(transa, m, n, alpha, A, lda, x, incx, beta, y, incy) &
      bind(c, name="oct_cuda_blas_zgemv")
      use iso_c_binding
      implicit none
 
      integer(c_int),            intent(in)    :: transa
      integer(c_int64_t),        intent(in)    :: m
      integer(c_int64_t),        intent(in)    :: n
      complex(c_double_complex), intent(in)    :: alpha
      type(c_ptr),               intent(in)    :: A
      integer(c_int64_t),        intent(in)    :: lda
      type(c_ptr),               intent(in)    :: x
      integer(c_int64_t),        intent(in)    :: incx
      complex(c_double_complex), intent(in)    :: beta
      type(c_ptr),               intent(inout) :: y
      integer(c_int64_t),        intent(in)    :: incy
    end subroutine cuda_blas_zgemv
  end interface
  ! SYRK/HERK
  interface
    subroutine cuda_blas_dsyrk(uplo, trans, n, k, alpha, A, lda, beta, C, ldc) bind(c, name="oct_cuda_blas_dsyrk")
      use iso_c_binding
      implicit none
 
      integer(c_int),     intent(in)    :: uplo
      integer(c_int),     intent(in)    :: trans
      integer(c_int64_t), intent(in)    :: n
      integer(c_int64_t), intent(in)    :: k
      real(c_double),     intent(in)    :: alpha
      type(c_ptr),        intent(in)    :: A
      integer(c_int64_t), intent(in)    :: lda
      real(c_double),     intent(in)    :: beta
      type(c_ptr),        intent(inout) :: C
      integer(c_int64_t), intent(in)    :: ldc
    end subroutine cuda_blas_dsyrk
 
    subroutine cuda_blas_zherk(uplo, trans, n, k, alpha, A, lda, beta, C, ldc) bind(c, name="oct_cuda_blas_zherk")
      use iso_c_binding
      implicit none
 
      integer(c_int),     intent(in)    :: uplo
      integer(c_int),     intent(in)    :: trans
      integer(c_int64_t), intent(in)    :: n
      integer(c_int64_t), intent(in)    :: k
      real(c_double),     intent(in)    :: alpha
      type(c_ptr),        intent(in)    :: A
      integer(c_int64_t), intent(in)    :: lda
      real(c_double),     intent(in)    :: beta
      type(c_ptr),        intent(inout) :: C
      integer(c_int64_t), intent(in)    :: ldc
    end subroutine cuda_blas_zherk
  end interface
 
  ! TRSM
  interface
    subroutine cuda_blas_dtrsm(side, uplo, trans, diag, m, n, alpha, A, lda, B, ldb) &
      bind(c, name="oct_cuda_blas_dtrsm")
      use iso_c_binding
      implicit none
 
      integer(c_int),     intent(in)    :: side
      integer(c_int),     intent(in)    :: uplo
      integer(c_int),     intent(in)    :: trans
      integer(c_int),     intent(in)    :: diag
      integer(c_int64_t), intent(in)    :: m
      integer(c_int64_t), intent(in)    :: n
      real(c_double),     intent(in)    :: alpha
      type(c_ptr),        intent(in)    :: A
      integer(c_int64_t), intent(in)    :: lda
      type(c_ptr),        intent(inout) :: B
      integer(c_int64_t), intent(in)    :: ldb
    end subroutine cuda_blas_dtrsm
 
    subroutine cuda_blas_ztrsm(side, uplo, trans, diag, m, n, alpha, A, lda, B, ldb) &
      bind(c, name="oct_cuda_blas_ztrsm")
      use iso_c_binding
      implicit none
 
      integer(c_int),            intent(in)    :: side
      integer(c_int),            intent(in)    :: uplo
      integer(c_int),            intent(in)    :: trans
      integer(c_int),            intent(in)    :: diag
      integer(c_int64_t),        intent(in)    :: m
      integer(c_int64_t),        intent(in)    :: n
      complex(c_double_complex), intent(in)    :: alpha
      type(c_ptr),               intent(in)    :: A
      integer(c_int64_t),        intent(in)    :: lda
      type(c_ptr),               intent(inout) :: B
      integer(c_int64_t),        intent(in)    :: ldb
    end subroutine cuda_blas_ztrsm
  end interface
 
contains
 
#include "undef.F90"
#include "complex.F90"
#include "accel_blas_inc.F90"
 
#include "undef.F90"
#include "real.F90"
#include "accel_blas_inc.F90"
 
end module accel_blas_oct_m