Single precision version for skewsymmetric ELPA

Makefile.am

@@ -65,8 +65,6 @@ libelpa@SUFFIX@_private_la_SOURCES = \
   src/elpa2/elpa2.F90 \
   src/elpa_generalized/cannon.c \
   src/helpers/matrix_plot.F90 \
-  src/general/elpa_ssmv.F90 \
-  src/general/elpa_ssr2.F90 \
   src/general/mod_elpa_skewsymmetric_blas.F90 \
   src/elpa_index.c
 

generate_automake_test_programs.py

@@ -282,7 +282,7 @@ print("  " + " \\\n  ".join([
 print("endif")
 
 name = "test_skewsymmetric_real_double"
-print("check_SCRIPTS += " + name + "_extended.sh")
+print("check_SCRIPTS += " + name)
 print("noinst_PROGRAMS += " + name)
 print(name + "_SOURCES = test/Fortran/test_skewsymmetric.F90")
 print(name + "_LDADD = $(test_program_ldadd)")
@@ -291,6 +291,20 @@ print("  " + " \\\n  ".join([
         domain_flag['real'],
         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"
 print("if ENABLE_AUTOTUNING")
 print("check_SCRIPTS += " + name + "_extended.sh")

src/general/elpa_ssmv_template.F90

@@ -17,7 +17,7 @@ subroutine elpa_cssmv(n, alpha, a, lda, x,  y)
 
   use precision
   use elpa_utilities, only : error_unit
-  !use elpa_blas_interfaces  
+  use elpa_blas_interfaces  
   implicit none
 #include "./precision_kinds.F90"
 

src/general/elpa_ssr2_template.F90

@@ -17,7 +17,7 @@ subroutine elpa_cssr2(n, x, y,  a, lda )
 
   use precision
   use elpa_utilities, only : error_unit
-  !use elpa_blas_interfaces
+  use elpa_blas_interfaces
   implicit none
 #include "./precision_kinds.F90"
 

src/helpers/mod_blas_interfaces.F90

@@ -49,6 +49,46 @@ module elpa_blas_interfaces
   implicit none
 
   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
     subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
@@ -289,7 +329,45 @@ module elpa_blas_interfaces
 
 
 !#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
     subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
@@ -518,6 +596,36 @@ module elpa_blas_interfaces
 
 
 !#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
     subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
@@ -674,6 +782,35 @@ module elpa_blas_interfaces
 
 
 !#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
     subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)

test/Fortran/test_skewsymmetric.F90

@@ -232,8 +232,13 @@ program test
      call MPI_BARRIER(MPI_COMM_WORLD, ierr)
 #endif     
 !      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)
+#endif
 !    status = 0
 !    call check_status(status, myid)
 

test/shared/test_check_correctness_template.F90

@@ -492,8 +492,8 @@ function check_correctness_evp_numeric_residuals_&
 
       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
-      MATH_DATATYPE(kind=rck)     :: as(1:na_rows,1:na_cols), z(1:na_rows,1:na_cols)
-      real(kind=rck)    :: ev(1:na)
+      MATH_DATATYPE(kind=rck)        :: as(1:na_rows,1:na_cols), z(1:na_rows,1:na_cols)
+      real(kind=rck)                 :: ev(1:na)
       integer(kind=c_int)            :: sc_desc(1:9)
 
       status = check_correctness_evp_numeric_residuals_&