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(handle, n, x, offx, incx, y, offy, incy, res, offres)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: offx
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(in)    :: y
      integer(int64),  intent(in)    :: offy
      integer(int64),  intent(in)    :: incy
      type(c_ptr),  intent(inout) :: res
      integer(int64),  intent(in)    :: offres
    end subroutine cuda_blas_ddot
 
    subroutine cuda_blas_zdotc(handle, n, x, offx, incx, y, offy, incy, res, offres)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: offx
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(in)    :: y
      integer(int64),  intent(in)    :: offy
      integer(int64),  intent(in)    :: incy
      type(c_ptr),  intent(inout) :: res
      integer(int64),  intent(in)    :: offres
    end subroutine cuda_blas_zdotc
 
    subroutine cuda_blas_zdotu(handle, n, x, offx, incx, y, offy, incy, res, offres)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: offx
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(in)    :: y
      integer(int64),  intent(in)    :: offy
      integer(int64),  intent(in)    :: incy
      type(c_ptr),  intent(inout) :: res
      integer(int64),  intent(in)    :: offres
    end subroutine cuda_blas_zdotu
  end interface
 
  ! NRM2
  interface
    subroutine cuda_blas_dnrm2(handle, n, x, offx, incx, res, offres)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: offx
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(inout) :: res
      integer(int64),  intent(in)    :: offres
    end subroutine cuda_blas_dnrm2
 
    subroutine cuda_blas_znrm2(handle, n, x, offx, incx, res, offres)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: offx
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(inout) :: res
      integer(int64),  intent(in)    :: offres
    end subroutine cuda_blas_znrm2
  end interface
 
  ! GEMM
  interface
    subroutine cuda_blas_dgemm(handle, transa, transb, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: transa
      integer,      intent(in)    :: transb
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      integer(int64),  intent(in)    :: k
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: B
      integer(int64),  intent(in)    :: ldb
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: C
      integer(int64),  intent(in)    :: ldc
    end subroutine cuda_blas_dgemm
 
    subroutine cuda_blas_zgemm(handle, transa, transb, m, n, k, alpha, A, lda, B, ldb, beta, C, ldc)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: transa
      integer,      intent(in)    :: transb
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      integer(int64),  intent(in)    :: k
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: B
      integer(int64),  intent(in)    :: ldb
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: C
      integer(int64),  intent(in)    :: ldc
    end subroutine cuda_blas_zgemm
  end interface
 
 
  ! GEMV
  interface
    subroutine cuda_blas_dgemv(handle, transa, m, n, alpha, A, lda, x, incx, beta, y, incy)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: transa
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: y
      integer(int64),  intent(in)    :: incy
    end subroutine cuda_blas_dgemv
 
    subroutine cuda_blas_zgemv(handle, transa, m, n, alpha, A, lda, x, incx, beta, y, incy)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: transa
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: x
      integer(int64),  intent(in)    :: incx
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: y
      integer(int64),  intent(in)    :: incy
    end subroutine cuda_blas_zgemv
  end interface
  ! SYRK/HERK
  interface
    subroutine cuda_blas_dsyrk(handle, uplo, trans, n, k, alpha, A, lda, beta, C, ldc)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: uplo
      integer,      intent(in)    :: trans
      integer(int64),  intent(in)    :: n
      integer(int64),  intent(in)    :: k
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: C
      integer(int64),  intent(in)    :: ldc
    end subroutine cuda_blas_dsyrk
 
    subroutine cuda_blas_zherk(handle, uplo, trans, n, k, alpha, A, lda, beta, C, ldc)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: uplo
      integer,      intent(in)    :: trans
      integer(int64),  intent(in)    :: n
      integer(int64),  intent(in)    :: k
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(in)    :: beta
      type(c_ptr),  intent(inout) :: C
      integer(int64),  intent(in)    :: ldc
    end subroutine cuda_blas_zherk
  end interface
 
  ! TRSM
  interface
    subroutine cuda_blas_dtrsm(handle, side, uplo, trans, diag, m, n, alpha, A, lda, B, ldb)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: side
      integer,      intent(in)    :: uplo
      integer,      intent(in)    :: trans
      integer,      intent(in)    :: diag
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(inout) :: B
      integer(int64),  intent(in)    :: ldb
    end subroutine cuda_blas_dtrsm
 
    subroutine cuda_blas_ztrsm(handle, side, uplo, trans, diag, m, n, alpha, A, lda, B, ldb)
      use iso_c_binding
      use, intrinsic :: iso_fortran_env
 
      implicit none
 
      type(c_ptr),  intent(in)    :: handle
      integer,      intent(in)    :: side
      integer,      intent(in)    :: uplo
      integer,      intent(in)    :: trans
      integer,      intent(in)    :: diag
      integer(int64),  intent(in)    :: m
      integer(int64),  intent(in)    :: n
      type(c_ptr),  intent(in)    :: alpha
      type(c_ptr),  intent(in)    :: A
      integer(int64),  intent(in)    :: lda
      type(c_ptr),  intent(inout) :: B
      integer(int64),  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