Commit d2828aed authored by Andreas Marek's avatar Andreas Marek

A bit of cleanup

parent b439cf66
...@@ -100,8 +100,8 @@ ...@@ -100,8 +100,8 @@
use redist use redist
implicit none implicit none
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
logical, intent(in) :: useGPU logical, intent(in) :: useGPU
integer(kind=ik), intent(in) :: na, nb, nblk, lda, matrixCols, mpi_comm_rows, mpi_comm_cols, communicator integer(kind=ik), intent(in) :: na, nb, nblk, lda, matrixCols, mpi_comm_rows, mpi_comm_cols, communicator
#if REALCASE == 1 #if REALCASE == 1
#ifdef USE_ASSUMED_SIZE #ifdef USE_ASSUMED_SIZE
...@@ -559,7 +559,7 @@ ...@@ -559,7 +559,7 @@
call hh_transform_real_& call hh_transform_real_&
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
call hh_transform_complex_& call hh_transform_complex_&
#endif #endif
&PRECISION & &PRECISION &
(obj, ab(2,na_s-n_off),vnorm2,hf,tau) (obj, ab(2,na_s-n_off),vnorm2,hf,tau)
...@@ -710,17 +710,17 @@ ...@@ -710,17 +710,17 @@
! Note that nr>=0 implies that diagonal block is full (nc==nb)! ! Note that nr>=0 implies that diagonal block is full (nc==nb)!
! Transform diagonal block ! Transform diagonal block
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 #if REALCASE == 1
call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1) call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1)
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
call PRECISION_HEMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_COMPLEX_PAIR_0_0, hd, 1) call PRECISION_HEMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_COMPLEX_PAIR_0_0, hd, 1)
#endif #endif
call obj%timer%stop("blas") call obj%timer%stop("blas")
#if REALCASE == 1 #if REALCASE == 1
x = dot_product(hv(1:nc),hd(1:nc))*tau x = dot_product(hv(1:nc),hd(1:nc))*tau
hd(1:nc) = hd(1:nc) - CONST_0_5*x*hv(1:nc) hd(1:nc) = hd(1:nc) - CONST_0_5*x*hv(1:nc)
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
x = dot_product(hv(1:nc),hd(1:nc))*conjg(tau) x = dot_product(hv(1:nc),hd(1:nc))*conjg(tau)
...@@ -745,7 +745,7 @@ ...@@ -745,7 +745,7 @@
if (nr<=0) cycle ! No subdiagonal block present any more if (nr<=0) cycle ! No subdiagonal block present any more
! Transform subdiagonal block ! Transform subdiagonal block
call obj%timer%start("blas") call obj%timer%start("blas")
call PRECISION_GEMV('N', nr, nb, tau, ab(nb+1,ns), 2*nb-1, hv, 1, & call PRECISION_GEMV('N', nr, nb, tau, ab(nb+1,ns), 2*nb-1, hv, 1, &
#if REALCASE == 1 #if REALCASE == 1
CONST_0_0, & CONST_0_0, &
...@@ -754,7 +754,7 @@ ...@@ -754,7 +754,7 @@
CONST_COMPLEX_PAIR_0_0, & CONST_COMPLEX_PAIR_0_0, &
#endif #endif
hs, 1) hs, 1)
call obj%timer%stop("blas") call obj%timer%stop("blas")
if (nr>1) then if (nr>1) then
! complete (old) Householder transformation for first column ! complete (old) Householder transformation for first column
...@@ -799,7 +799,7 @@ ...@@ -799,7 +799,7 @@
#endif #endif
! update subdiagonal block for old and new Householder transformation ! update subdiagonal block for old and new Householder transformation
! This way we can use a nonsymmetric rank 2 update which is (hopefully) faster ! This way we can use a nonsymmetric rank 2 update which is (hopefully) faster
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 #if REALCASE == 1
call PRECISION_GEMV('T', & call PRECISION_GEMV('T', &
#endif #endif
...@@ -814,7 +814,7 @@ ...@@ -814,7 +814,7 @@
CONST_COMPLEX_PAIR_0_0, & CONST_COMPLEX_PAIR_0_0, &
#endif #endif
h(2), 1) h(2), 1)
call obj%timer%stop("blas") call obj%timer%stop("blas")
x = dot_product(hs(1:nr),hv_t(1:nr,my_thread))*tau_t(my_thread) x = dot_product(hs(1:nr),hv_t(1:nr,my_thread))*tau_t(my_thread)
h(2:nb) = h(2:nb) - x*hv(2:nb) h(2:nb) = h(2:nb) - x*hv(2:nb)
...@@ -1038,7 +1038,7 @@ ...@@ -1038,7 +1038,7 @@
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
ab(1,ne) = CONST_COMPLEX_0_0 ab(1,ne) = CONST_COMPLEX_0_0
#endif #endif
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 #if REALCASE == 1
call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1) call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1)
...@@ -1054,7 +1054,7 @@ ...@@ -1054,7 +1054,7 @@
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_0_0,hs,1) CONST_COMPLEX_PAIR_0_0,hs,1)
#endif #endif
call obj%timer%stop("blas") call obj%timer%stop("blas")
! ... then request last column ... ! ... then request last column ...
#ifdef WITH_MPI #ifdef WITH_MPI
...@@ -1092,7 +1092,7 @@ ...@@ -1092,7 +1092,7 @@
else else
! Normal matrix multiply ! Normal matrix multiply
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 #if REALCASE == 1
call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1) call PRECISION_SYMV('L', nc, tau, ab(1,ns), 2*nb-1, hv, 1, CONST_0_0, hd, 1)
#endif #endif
...@@ -1107,7 +1107,7 @@ ...@@ -1107,7 +1107,7 @@
CONST_COMPLEX_PAIR_0_0, hs, 1) CONST_COMPLEX_PAIR_0_0, hs, 1)
#endif #endif
call obj%timer%stop("blas") call obj%timer%stop("blas")
endif endif
! Calculate first column of subdiagonal block and calculate new ! Calculate first column of subdiagonal block and calculate new
...@@ -1118,7 +1118,7 @@ ...@@ -1118,7 +1118,7 @@
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
hv_new(:) = 0 ! Needed, last rows must be 0 for nr < nb hv_new(:) = 0 ! Needed, last rows must be 0 for nr < nb
tau_new = 0 tau_new = 0
#endif #endif
if (nr>0) then if (nr>0) then
...@@ -1269,7 +1269,7 @@ ...@@ -1269,7 +1269,7 @@
if (nr>0) then if (nr>0) then
if (nr>1) then if (nr>1) then
call obj%timer%start("blas") call obj%timer%start("blas")
#if REALCASE == 1 #if REALCASE == 1
call PRECISION_GEMV('T', & call PRECISION_GEMV('T', &
#endif #endif
...@@ -1283,7 +1283,7 @@ ...@@ -1283,7 +1283,7 @@
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
CONST_COMPLEX_PAIR_0_0, h(2), 1) CONST_COMPLEX_PAIR_0_0, h(2), 1)
#endif #endif
call obj%timer%stop("blas") call obj%timer%stop("blas")
x = dot_product(hs(1:nr),hv_new(1:nr))*tau_new x = dot_product(hs(1:nr),hv_new(1:nr))*tau_new
h(2:nb) = h(2:nb) - x*hv(2:nb) h(2:nb) = h(2:nb) - x*hv(2:nb)
......
...@@ -75,39 +75,39 @@ subroutine redist_band_& ...@@ -75,39 +75,39 @@ subroutine redist_band_&
use elpa_mpi use elpa_mpi
implicit none implicit none
class(elpa_abstract_impl_t), intent(inout) :: obj class(elpa_abstract_impl_t), intent(inout) :: obj
logical, intent(in) :: useGPU logical, intent(in) :: useGPU
integer(kind=ik), intent(in) :: lda, na, nblk, nbw, matrixCols, mpi_comm_rows, mpi_comm_cols, communicator integer(kind=ik), intent(in) :: lda, na, nblk, nbw, matrixCols, mpi_comm_rows, mpi_comm_cols, communicator
#if REALCASE == 1 #if REALCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(in) :: r_a(lda, matrixCols) MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(in) :: r_a(lda, matrixCols)
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(in) :: c_a(lda, matrixCols) MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(in) :: c_a(lda, matrixCols)
#endif #endif
#if REALCASE == 1 #if REALCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(out) :: r_ab(:,:) MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(out) :: r_ab(:,:)
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(out) :: c_ab(:,:) MATH_DATATYPE(kind=C_DATATYPE_KIND), intent(out) :: c_ab(:,:)
#endif #endif
integer(kind=ik), allocatable :: ncnt_s(:), nstart_s(:), ncnt_r(:), nstart_r(:), & integer(kind=ik), allocatable :: ncnt_s(:), nstart_s(:), ncnt_r(:), nstart_r(:), &
global_id(:,:), global_id_tmp(:,:), block_limits(:) global_id(:,:), global_id_tmp(:,:), block_limits(:)
#if REALCASE == 1 #if REALCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), allocatable :: r_sbuf(:,:,:), r_rbuf(:,:,:), r_buf(:,:) MATH_DATATYPE(kind=C_DATATYPE_KIND), allocatable :: r_sbuf(:,:,:), r_rbuf(:,:,:), r_buf(:,:)
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
MATH_DATATYPE(kind=C_DATATYPE_KIND), allocatable :: c_sbuf(:,:,:), c_rbuf(:,:,:), c_buf(:,:) MATH_DATATYPE(kind=C_DATATYPE_KIND), allocatable :: c_sbuf(:,:,:), c_rbuf(:,:,:), c_buf(:,:)
#endif #endif
integer(kind=ik) :: i, j, my_pe, n_pes, my_prow, np_rows, my_pcol, np_cols, & integer(kind=ik) :: i, j, my_pe, n_pes, my_prow, np_rows, my_pcol, np_cols, &
nfact, np, npr, npc, mpierr, is, js nfact, np, npr, npc, mpierr, is, js
integer(kind=ik) :: nblocks_total, il, jl, l_rows, l_cols, n_off integer(kind=ik) :: nblocks_total, il, jl, l_rows, l_cols, n_off
logical :: successCUDA logical :: successCUDA
integer(kind=c_intptr_t) :: a_dev integer(kind=c_intptr_t) :: a_dev
integer(kind=c_intptr_t), parameter :: size_of_datatype = size_of_& integer(kind=c_intptr_t), parameter :: size_of_datatype = size_of_&
&PRECISION& &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