Commit 6f4f00e5 authored by Pavel Kus's avatar Pavel Kus
Browse files

some single/double in elpa1 directory

parent 8b7a8051
...@@ -62,6 +62,7 @@ ...@@ -62,6 +62,7 @@
use precision use precision
use elpa_abstract_impl use elpa_abstract_impl
implicit none implicit none
#include "../general/precision_kinds.F90"
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
integer(kind=ik), intent(in) :: na, nm, ldq, nqoff, nblk, matrixCols, mpi_comm_rows, & integer(kind=ik), intent(in) :: na, nm, ldq, nqoff, nblk, matrixCols, mpi_comm_rows, &
mpi_comm_cols, npc_0, npc_n mpi_comm_cols, npc_0, npc_n
...@@ -501,7 +502,7 @@ ...@@ -501,7 +502,7 @@
d(1:na1) = dbase(1:na1) - ddiff(1:na1) d(1:na1) = dbase(1:na1) - ddiff(1:na1)
! Calculate scale factors for eigenvectors ! Calculate scale factors for eigenvectors
ev_scale(:) = CONST_0_0 ev_scale(:) = 0.0_rk
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
......
...@@ -62,6 +62,7 @@ subroutine solve_tridi_& ...@@ -62,6 +62,7 @@ subroutine solve_tridi_&
use precision use precision
use elpa_abstract_impl use elpa_abstract_impl
implicit none implicit none
#include "../../src/general/precision_kinds.F90"
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
integer(kind=ik), intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols integer(kind=ik), intent(in) :: na, nev, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols
real(kind=REAL_DATATYPE), intent(inout) :: d(na), e(na) real(kind=REAL_DATATYPE), intent(inout) :: d(na), e(na)
...@@ -96,7 +97,7 @@ subroutine solve_tridi_& ...@@ -96,7 +97,7 @@ subroutine solve_tridi_&
l_cols = local_index(na, my_pcol, np_cols, nblk, -1) ! Local columns of q l_cols = local_index(na, my_pcol, np_cols, nblk, -1) ! Local columns of q
! Set Q to 0 ! Set Q to 0
q(1:l_rows, 1:l_cols) = CONST_0_0 q(1:l_rows, 1:l_cols) = 0.0_rk
! Get the limits of the subdivisons, each subdivison has as many cols ! Get the limits of the subdivisons, each subdivison has as many cols
! as fit on the respective processor column ! as fit on the respective processor column
......
...@@ -157,7 +157,7 @@ ...@@ -157,7 +157,7 @@
use precision use precision
use elpa_abstract_impl use elpa_abstract_impl
implicit none implicit none
#include "../../src/general/precision_kinds.F90"
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
integer(kind=ik) :: n, i integer(kind=ik) :: n, i
real(kind=REAL_DATATYPE) :: d(n), z(n), delta(n), rho, dlam real(kind=REAL_DATATYPE) :: d(n), z(n), delta(n), rho, dlam
...@@ -180,7 +180,7 @@ ...@@ -180,7 +180,7 @@
dshift = d(n) dshift = d(n)
delta(:) = d(:) - dshift delta(:) = d(:) - dshift
a = CONST_0_0 ! delta(n) a = 0.0_rk ! delta(n)
b = rho*SUM(z(:)**2) + CONST_1_0 ! rho*SUM(z(:)**2) is the lower bound for the guess b = rho*SUM(z(:)**2) + CONST_1_0 ! rho*SUM(z(:)**2) is the lower bound for the guess
else else
......
! This file is part of ELPA.
! !
! The ELPA library was originally created by the ELPA consortium, ! The ELPA library was originally created by the ELPA consortium,
! consisting of the following organizations: ! consisting of the following organizations:
...@@ -61,25 +60,17 @@ ...@@ -61,25 +60,17 @@
use elpa_abstract_impl use elpa_abstract_impl
implicit none implicit none
#include "../../src/general/precision_kinds.F90"
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
character*1 :: uplo_a, uplo_c character*1 :: uplo_a, uplo_c
integer(kind=ik), intent(in) :: ldb, ldbCols, ldc, ldcCols integer(kind=ik), intent(in) :: ldb, ldbCols, ldc, ldcCols
integer(kind=ik) :: na, ncb integer(kind=ik) :: na, ncb
#if REALCASE == 1
#ifdef USE_ASSUMED_SIZE
real(kind=REAL_DATATYPE) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*)
#else
real(kind=REAL_DATATYPE) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
#endif
#if COMPLEXCASE == 1
#ifdef USE_ASSUMED_SIZE #ifdef USE_ASSUMED_SIZE
complex(kind=COMPLEX_DATATYPE) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*) MATH_DATATYPE(kind=rck) :: a(obj%local_nrows,*), b(ldb,*), c(ldc,*)
#else #else
complex(kind=COMPLEX_DATATYPE) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols) MATH_DATATYPE(kind=rck) :: a(obj%local_nrows,obj%local_ncols), b(ldb,ldbCols), c(ldc,ldcCols)
#endif
#endif #endif
integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr integer(kind=ik) :: my_prow, my_pcol, np_rows, np_cols, mpierr
integer(kind=ik) :: l_cols, l_rows, l_rows_np integer(kind=ik) :: l_cols, l_rows, l_rows_np
...@@ -89,12 +80,7 @@ ...@@ -89,12 +80,7 @@
integer(kind=ik), allocatable :: lrs_save(:), lre_save(:) integer(kind=ik), allocatable :: lrs_save(:), lre_save(:)
logical :: a_lower, a_upper, c_lower, c_upper logical :: a_lower, a_upper, c_lower, c_upper
#if REALCASE == 1 MATH_DATATYPE(kind=rck), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
real(kind=REAL_DATATYPE), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
#endif
#if COMPLEXCASE == 1
complex(kind=COMPLEX_DATATYPE), allocatable :: aux_mat(:,:), aux_bc(:), tmp1(:,:), tmp2(:,:)
#endif
integer(kind=ik) :: istat integer(kind=ik) :: istat
character(200) :: errorMessage character(200) :: errorMessage
logical :: success logical :: success
...@@ -279,28 +265,8 @@ ...@@ -279,28 +265,8 @@
if (lrs<=lre) then if (lrs<=lre) then
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 call PRECISION_GEMM(BLAS_TRANS_OR_CONJ, 'N', nstor, lce-lcs+1, lre-lrs+1, ONE, &
call PRECISION_GEMM('T', 'N', & aux_mat(lrs,1), ubound(aux_mat,dim=1), b(lrs,lcs), ldb,ZERO, tmp1, nstor)
#endif
#if COMPLEXCASE == 1
call PRECISION_GEMM('C', 'N', &
#endif
nstor, lce-lcs+1, lre-lrs+1, &
#if REALCASE == 1
CONST_1_0, &
#endif
#if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_1_0, &
#endif
aux_mat(lrs,1), ubound(aux_mat,dim=1), &
b(lrs,lcs), ldb, &
#if REALCASE == 1
CONST_0_0, &
#endif
#if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_0_0, &
#endif
tmp1, nstor)
call obj%timer%stop("blas") call obj%timer%stop("blas")
else else
tmp1 = 0 tmp1 = 0
...@@ -309,16 +275,8 @@ ...@@ -309,16 +275,8 @@
! Sum up the results and send to processor row np ! Sum up the results and send to processor row np
#ifdef WITH_MPI #ifdef WITH_MPI
call obj%timer%start("mpi_communication") call obj%timer%start("mpi_communication")
call mpi_reduce(tmp1, tmp2, nstor*(lce-lcs+1), & call mpi_reduce(tmp1, tmp2, nstor*(lce-lcs+1), MPI_MATH_DATATYPE_PRECISION, &
#if REALCASE == 1
MPI_REAL_PRECISION, &
#endif
#if COMPLEXCASE == 1
MPI_COMPLEX_PRECISION, &
#endif
MPI_SUM, np, mpi_comm_rows, mpierr) MPI_SUM, np, mpi_comm_rows, mpierr)
call obj%timer%stop("mpi_communication") call obj%timer%stop("mpi_communication")
! Put the result into C ! Put the result into C
if (my_prow==np) c(nr_done+1:nr_done+nstor,lcs:lce) = tmp2(1:nstor,lcs:lce) if (my_prow==np) c(nr_done+1:nr_done+nstor,lcs:lce) = tmp2(1:nstor,lcs:lce)
...@@ -361,8 +319,3 @@ ...@@ -361,8 +319,3 @@
&PRECISION& &PRECISION&
&") &")
#undef REALCASE
#undef COMPLEXCASE
#undef DOUBLE_PRECISION
#undef SINGLE_PRECISION
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