Commit c76339cb authored by Pavel Kus's avatar Pavel Kus

adding single precision variants of the new cuda wrappers

parent aa44b1b1
...@@ -387,7 +387,14 @@ extern "C" { ...@@ -387,7 +387,14 @@ extern "C" {
m, n, k, &alpha_casted, A_casted, lda, B_casted, ldb, &beta_casted, C_casted, ldc); m, n, k, &alpha_casted, A_casted, lda, B_casted, ldb, &beta_casted, C_casted, ldc);
} }
// TODO so far only double real // TODO so far only real
void cublasSsyrk_elpa_wrapper (intptr_t handle, char uplo, char trans, int n, int k,
float alpha, const float *A, int lda,
float beta, float *C, int ldc) {
cublasSsyrk(*((cublasHandle_t*)handle), fill_mode_new_api(uplo), operation_new_api(trans),
n, k, &alpha, A, lda, &beta, C, ldc);
}
void cublasDsyrk_elpa_wrapper (intptr_t handle, char uplo, char trans, int n, int k, void cublasDsyrk_elpa_wrapper (intptr_t handle, char uplo, char trans, int n, int k,
double alpha, const double *A, int lda, double alpha, const double *A, int lda,
double beta, double *C, int ldc) { double beta, double *C, int ldc) {
...@@ -395,7 +402,11 @@ extern "C" { ...@@ -395,7 +402,11 @@ extern "C" {
n, k, &alpha, A, lda, &beta, C, ldc); n, k, &alpha, A, lda, &beta, C, ldc);
} }
// TODO so far only double real // TODO so far only real
void cublasSscal_elpa_wrapper (intptr_t handle, int n, float alpha, float *x, int incx) {
cublasSscal(*((cublasHandle_t*)handle), n, &alpha, x, incx);
}
void cublasDscal_elpa_wrapper (intptr_t handle, int n, double alpha, double *x, int incx) { void cublasDscal_elpa_wrapper (intptr_t handle, int n, double alpha, double *x, int incx) {
cublasDscal(*((cublasHandle_t*)handle), n, &alpha, x, incx); cublasDscal(*((cublasHandle_t*)handle), n, &alpha, x, incx);
} }
......
...@@ -328,7 +328,7 @@ module cuda_functions ...@@ -328,7 +328,7 @@ module cuda_functions
end subroutine cublas_strmm_c end subroutine cublas_strmm_c
end interface end interface
!TODO so far only double real !TODO so far only real
interface interface
subroutine cublas_dsyrk_c(handle, uplo, trans, n, k, alpha, a, lda, beta, c, ldc) & subroutine cublas_dsyrk_c(handle, uplo, trans, n, k, alpha, a, lda, beta, c, ldc) &
bind(C,name='cublasDsyrk_elpa_wrapper') bind(C,name='cublasDsyrk_elpa_wrapper')
...@@ -345,7 +345,38 @@ module cuda_functions ...@@ -345,7 +345,38 @@ module cuda_functions
end subroutine cublas_dsyrk_c end subroutine cublas_dsyrk_c
end interface end interface
!TODO so far only double real interface
subroutine cublas_ssyrk_c(handle, uplo, trans, n, k, alpha, a, lda, beta, c, ldc) &
bind(C,name='cublasSsyrk_elpa_wrapper')
use iso_c_binding
implicit none
character(1, C_CHAR), value :: uplo, trans
integer(kind=C_INT), value :: n, k
integer(kind=C_INT), intent(in), value :: lda, ldc
real(kind=C_FLOAT), value :: alpha, beta
integer(kind=C_intptr_T), value :: a, c
integer(kind=C_intptr_T), value :: handle
end subroutine cublas_ssyrk_c
end interface
!TODO so far only real
interface
subroutine cublas_sscal_c(handle, n, alpha, x, incx) &
bind(C,name='cublasSscal_elpa_wrapper')
use iso_c_binding
implicit none
integer(kind=C_INT), value :: n
integer(kind=C_INT), intent(in), value :: incx
real(kind=C_FLOAT), value :: alpha
integer(kind=C_intptr_T), value :: x
integer(kind=C_intptr_T), value :: handle
end subroutine cublas_sscal_c
end interface
interface interface
subroutine cublas_dscal_c(handle, n, alpha, x, incx) & subroutine cublas_dscal_c(handle, n, alpha, x, incx) &
bind(C,name='cublasDscal_elpa_wrapper') bind(C,name='cublasDscal_elpa_wrapper')
...@@ -793,7 +824,22 @@ module cuda_functions ...@@ -793,7 +824,22 @@ module cuda_functions
#endif #endif
end subroutine cublas_strmm end subroutine cublas_strmm
!TODO so far only double real !TODO so far only real
subroutine cublas_ssyrk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
use iso_c_binding
implicit none
character(1, C_CHAR), value :: uplo, trans
integer(kind=C_INT) :: n, k
integer(kind=C_INT), intent(in) :: lda, ldc
real(kind=C_FLOAT) :: alpha, beta
integer(kind=C_intptr_T) :: a, c
#ifdef WITH_GPU_VERSION
call cublas_ssyrk_c(cublasHandle, uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
#endif
end subroutine cublas_ssyrk
subroutine cublas_dsyrk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc) subroutine cublas_dsyrk(uplo, trans, n, k, alpha, a, lda, beta, c, ldc)
use iso_c_binding use iso_c_binding
...@@ -809,7 +855,7 @@ module cuda_functions ...@@ -809,7 +855,7 @@ module cuda_functions
#endif #endif
end subroutine cublas_dsyrk end subroutine cublas_dsyrk
!TODO so far only double real !TODO so far only real
subroutine cublas_dscal(n, alpha, x, incx) subroutine cublas_dscal(n, alpha, x, incx)
use iso_c_binding use iso_c_binding
...@@ -824,6 +870,20 @@ module cuda_functions ...@@ -824,6 +870,20 @@ module cuda_functions
end subroutine cublas_dscal end subroutine cublas_dscal
subroutine cublas_sscal(n, alpha, x, incx)
use iso_c_binding
implicit none
integer(kind=C_INT) :: n
integer(kind=C_INT), intent(in) :: incx
real(kind=C_FLOAT) :: alpha
integer(kind=C_intptr_T) :: x
#ifdef WITH_GPU_VERSION
call cublas_sscal_c(cublasHandle, n, alpha, x, incx)
#endif
end subroutine cublas_sscal
subroutine cublas_zgemm(cta, ctb, m, n, k, alpha, a, lda, b, ldb, beta, c,ldc) subroutine cublas_zgemm(cta, ctb, m, n, k, alpha, a, lda, b, ldb, beta, c,ldc)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment