Commit cf514bab authored by Andreas Marek's avatar Andreas Marek
Browse files

Single precision version for skewsymmetric ELPA

parent 56af2503
...@@ -65,8 +65,6 @@ libelpa@SUFFIX@_private_la_SOURCES = \ ...@@ -65,8 +65,6 @@ libelpa@SUFFIX@_private_la_SOURCES = \
src/elpa2/elpa2.F90 \ src/elpa2/elpa2.F90 \
src/elpa_generalized/cannon.c \ src/elpa_generalized/cannon.c \
src/helpers/matrix_plot.F90 \ src/helpers/matrix_plot.F90 \
src/general/elpa_ssmv.F90 \
src/general/elpa_ssr2.F90 \
src/general/mod_elpa_skewsymmetric_blas.F90 \ src/general/mod_elpa_skewsymmetric_blas.F90 \
src/elpa_index.c src/elpa_index.c
......
...@@ -282,7 +282,7 @@ print(" " + " \\\n ".join([ ...@@ -282,7 +282,7 @@ print(" " + " \\\n ".join([
print("endif") print("endif")
name = "test_skewsymmetric_real_double" name = "test_skewsymmetric_real_double"
print("check_SCRIPTS += " + name + "_extended.sh") print("check_SCRIPTS += " + name)
print("noinst_PROGRAMS += " + name) print("noinst_PROGRAMS += " + name)
print(name + "_SOURCES = test/Fortran/test_skewsymmetric.F90") print(name + "_SOURCES = test/Fortran/test_skewsymmetric.F90")
print(name + "_LDADD = $(test_program_ldadd)") print(name + "_LDADD = $(test_program_ldadd)")
...@@ -291,6 +291,20 @@ print(" " + " \\\n ".join([ ...@@ -291,6 +291,20 @@ print(" " + " \\\n ".join([
domain_flag['real'], domain_flag['real'],
prec_flag['double']])) prec_flag['double']]))
name = "test_skewsymmetric_real_single"
print("if WANT_SINGLE_PRECISION_REAL")
print("check_SCRIPTS += " + name)
print("noinst_PROGRAMS += " + name)
print(name + "_SOURCES = test/Fortran/test_skewsymmetric.F90")
print(name + "_LDADD = $(test_program_ldadd)")
print(name + "_FCFLAGS = $(test_program_fcflags) \\")
print(" " + " \\\n ".join([
domain_flag['real'],
prec_flag['single']]))
print("endif")
name = "validate_multiple_objs_real_double_c_version" name = "validate_multiple_objs_real_double_c_version"
print("if ENABLE_AUTOTUNING") print("if ENABLE_AUTOTUNING")
print("check_SCRIPTS += " + name + "_extended.sh") print("check_SCRIPTS += " + name + "_extended.sh")
......
...@@ -17,7 +17,7 @@ subroutine elpa_cssmv(n, alpha, a, lda, x, y) ...@@ -17,7 +17,7 @@ subroutine elpa_cssmv(n, alpha, a, lda, x, y)
use precision use precision
use elpa_utilities, only : error_unit use elpa_utilities, only : error_unit
!use elpa_blas_interfaces use elpa_blas_interfaces
implicit none implicit none
#include "./precision_kinds.F90" #include "./precision_kinds.F90"
......
...@@ -17,7 +17,7 @@ subroutine elpa_cssr2(n, x, y, a, lda ) ...@@ -17,7 +17,7 @@ subroutine elpa_cssr2(n, x, y, a, lda )
use precision use precision
use elpa_utilities, only : error_unit use elpa_utilities, only : error_unit
!use elpa_blas_interfaces use elpa_blas_interfaces
implicit none implicit none
#include "./precision_kinds.F90" #include "./precision_kinds.F90"
......
...@@ -49,6 +49,46 @@ module elpa_blas_interfaces ...@@ -49,6 +49,46 @@ module elpa_blas_interfaces
implicit none implicit none
public public
interface
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
use precision
implicit none
integer(kind=BLAS_KIND) :: M, N, INCX, INCY, LDA
real(kind=rk8), intent(in) :: ALPHA, X(*), Y(*)
real(kind=rk8), intent(inout) :: A(LDA, *)
end subroutine
end interface
interface
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
real(kind=rk8), intent(in) :: DA, DX(*)
real(kind=rk8), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine dcopy(N, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
real(kind=rk8), intent(in) :: DX(*)
real(kind=rk8), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine dscal(N, DA, DX, INCX)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX
real(kind=rk8) :: DA
real(kind=rk8), intent(inout) :: DX(*)
end subroutine
end interface
interface interface
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
...@@ -289,7 +329,45 @@ module elpa_blas_interfaces ...@@ -289,7 +329,45 @@ module elpa_blas_interfaces
!#endif /* DOUBLE_PRECISION_REAL */ !#endif /* DOUBLE_PRECISION_REAL */
interface
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
use precision
implicit none
integer(kind=BLAS_KIND) :: M, N, INCX, INCY, LDA
real(kind=rk4), intent(in) :: ALPHA, X(*), Y(*)
real(kind=rk4), intent(inout) :: A(LDA, *)
end subroutine
end interface
interface
subroutine saxpy(N, DA, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
real(kind=rk4), intent(in) :: DA, DX(*)
real(kind=rk4), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine scopy(N, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
real(kind=rk4), intent(in) :: DX(*)
real(kind=rk4), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine sscal(N, DA, DX, INCX)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX
real(kind=rk4) :: DA
real(kind=rk4), intent(inout) :: DX(*)
end subroutine
end interface
interface interface
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
...@@ -518,6 +596,36 @@ module elpa_blas_interfaces ...@@ -518,6 +596,36 @@ module elpa_blas_interfaces
!#endif /* SINGLE_PRECSION_REAL */ !#endif /* SINGLE_PRECSION_REAL */
interface
subroutine zaxpy(N, DA, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
complex(kind=ck8), intent(in) :: DA, DX(*)
complex(kind=ck8), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine zcopy(N, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
complex(kind=ck8), intent(in) :: DX(*)
complex(kind=ck8), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine zscal(N, DA, DX, INCX)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX
complex(kind=ck8) :: DA
complex(kind=ck8), intent(inout) :: DX(*)
end subroutine
end interface
interface interface
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
...@@ -674,6 +782,35 @@ module elpa_blas_interfaces ...@@ -674,6 +782,35 @@ module elpa_blas_interfaces
!#endif /* DOUBLE_PRECISION_COMPLEX */ !#endif /* DOUBLE_PRECISION_COMPLEX */
interface
subroutine caxpy(N, DA, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
complex(kind=ck4), intent(in) :: DA, DX(*)
complex(kind=ck4), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine ccopy(N, DX, INCX, DY, INCY)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX, INCY
complex(kind=ck4), intent(in) :: DX(*)
complex(kind=ck4), intent(inout) :: DY(*)
end subroutine
end interface
interface
subroutine cscal(N, DA, DX, INCX)
use precision
implicit none
integer(kind=BLAS_KIND) :: N, INCX
complex(kind=ck4) :: DA
complex(kind=ck4), intent(inout) :: DX(*)
end subroutine
end interface
interface interface
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC) subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
......
...@@ -232,8 +232,13 @@ program test ...@@ -232,8 +232,13 @@ program test
call MPI_BARRIER(MPI_COMM_WORLD, ierr) call MPI_BARRIER(MPI_COMM_WORLD, ierr)
#endif #endif
! as_complex(:,:) = z_complex(:,:) ! as_complex(:,:) = z_complex(:,:)
status = check_correctness_evp_numeric_residuals_complex_double(na, nev, as_complex, z_complex, ev_complex, sc_desc, & #ifdef TEST_SINGLE
status = check_correctness_evp_numeric_residuals_complex_single(na, nev, as_complex, z_complex, ev_complex, sc_desc, &
nblk, myid, np_rows,np_cols, my_prow, my_pcol)
#else
status = check_correctness_evp_numeric_residuals_complex_double(na, nev, as_complex, z_complex, ev_complex, sc_desc, &
nblk, myid, np_rows,np_cols, my_prow, my_pcol) nblk, myid, np_rows,np_cols, my_prow, my_pcol)
#endif
! status = 0 ! status = 0
! call check_status(status, myid) ! call check_status(status, myid)
......
...@@ -492,8 +492,8 @@ function check_correctness_evp_numeric_residuals_& ...@@ -492,8 +492,8 @@ function check_correctness_evp_numeric_residuals_&
integer(kind=c_int) :: status integer(kind=c_int) :: status
integer(kind=c_int), value :: na, nev, myid, na_rows, na_cols, nblk, np_rows, np_cols, my_prow, my_pcol integer(kind=c_int), value :: na, nev, myid, na_rows, na_cols, nblk, np_rows, np_cols, my_prow, my_pcol
MATH_DATATYPE(kind=rck) :: as(1:na_rows,1:na_cols), z(1:na_rows,1:na_cols) MATH_DATATYPE(kind=rck) :: as(1:na_rows,1:na_cols), z(1:na_rows,1:na_cols)
real(kind=rck) :: ev(1:na) real(kind=rck) :: ev(1:na)
integer(kind=c_int) :: sc_desc(1:9) integer(kind=c_int) :: sc_desc(1:9)
status = check_correctness_evp_numeric_residuals_& status = check_correctness_evp_numeric_residuals_&
......
Supports Markdown
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