Commit 38df8b3b authored by Pavel Kus's avatar Pavel Kus

elpa2_tridiag_band_template hh_trans real/complex unified

parent a9e85204
...@@ -59,13 +59,7 @@ ...@@ -59,13 +59,7 @@
#endif #endif
&PRECISION & &PRECISION &
(obj, na, nb, nblk, aMatrix, a_dev, lda, d, e, matrixCols, & (obj, na, nb, nblk, aMatrix, a_dev, lda, d, e, matrixCols, &
#if REALCASE == 1 hh_trans, mpi_comm_rows, mpi_comm_cols, communicator, useGPU, wantDebug)
hh_trans_real, &
#endif
#if COMPLEXCASE == 1
hh_trans_complex, &
#endif
mpi_comm_rows, mpi_comm_cols, communicator, useGPU, wantDebug)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! tridiag_band_real/complex: ! tridiag_band_real/complex:
! Reduces a real symmetric band matrix to tridiagonal form ! Reduces a real symmetric band matrix to tridiagonal form
...@@ -81,7 +75,7 @@ ...@@ -81,7 +75,7 @@
! lda Leading dimension of a ! lda Leading dimension of a
! matrixCols local columns of matrix a ! matrixCols local columns of matrix a
! !
! hh_trans_real/complex : housholder vectors ! hh_trans : housholder vectors
! !
! d(na) Diagonal of tridiagonal matrix, set only on PE 0 (output) ! d(na) Diagonal of tridiagonal matrix, set only on PE 0 (output)
! !
...@@ -99,7 +93,7 @@ ...@@ -99,7 +93,7 @@
use iso_c_binding use iso_c_binding
use redist use redist
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
logical, intent(in) :: useGPU, wantDebug logical, intent(in) :: useGPU, wantDebug
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
...@@ -119,15 +113,7 @@ ...@@ -119,15 +113,7 @@
#endif /* COMPLEXCASE */ #endif /* COMPLEXCASE */
integer(kind=c_intptr_t) :: a_dev integer(kind=c_intptr_t) :: a_dev
real(kind=REAL_DATATYPE), intent(out) :: d(na), e(na) ! set only on PE 0 real(kind=REAL_DATATYPE), intent(out) :: d(na), e(na) ! set only on PE 0
#if REALCASE == 1 MATH_DATATYPE(kind=rck), intent(out), allocatable :: hh_trans(:,:)
real(kind=REAL_DATATYPE), intent(out), &
allocatable :: hh_trans_real(:,:)
#endif
#if COMPLEXCASE == 1
complex(kind=COMPLEX_DATATYPE), intent(inout), &
allocatable :: hh_trans_complex(:,:)
#endif
real(kind=REAL_DATATYPE) :: vnorm2 real(kind=REAL_DATATYPE) :: vnorm2
#if REALCASE == 1 #if REALCASE == 1
real(kind=REAL_DATATYPE) :: hv(nb), tau, x, h(nb), ab_s(1+nb), hv_s(nb), hv_new(nb), tau_new, hf real(kind=REAL_DATATYPE) :: hv(nb), tau, x, h(nb), ab_s(1+nb), hv_s(nb), hv_new(nb), tau_new, hf
...@@ -302,20 +288,16 @@ ...@@ -302,20 +288,16 @@
! Allocate space for HH vectors ! Allocate space for HH vectors
#if REALCASE == 1 allocate(hh_trans(nb,num_hh_vecs), stat=istat, errmsg=errorMessage)
allocate(hh_trans_real(nb,num_hh_vecs), stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"tridiag_band_real: error when allocating hh_trans_real"//errorMessage #if REALCASE == 1
stop 1 print *,"tridiag_band_real: error when allocating hh_trans"//errorMessage
endif
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
allocate(hh_trans_complex(nb,num_hh_vecs), stat=istat, errmsg=errorMessage) print *,"tridiag_band_complex: error when allocating hh_trans "//errorMessage
if (istat .ne. 0) then #endif
print *,"tridiag_band_complex: error when allocating hh_trans_comples "//errorMessage
stop 1 stop 1
endif endif
#endif
! Allocate and init MPI requests ! Allocate and init MPI requests
...@@ -345,12 +327,7 @@ ...@@ -345,12 +327,7 @@
num_chunks = num_chunks+1 num_chunks = num_chunks+1
#ifdef WITH_MPI #ifdef WITH_MPI
if (wantDebug) call obj%timer%start("mpi_communication") if (wantDebug) call obj%timer%start("mpi_communication")
#if REALCASE == 1 call mpi_irecv(hh_trans(1,num_hh_vecs+1), &
call mpi_irecv(hh_trans_real(1,num_hh_vecs+1), &
#endif
#if COMPLEXCASE == 1
call mpi_irecv(hh_trans_complex(1,num_hh_vecs+1), &
#endif
nb*local_size, & nb*local_size, &
#if REALCASE == 1 #if REALCASE == 1
MPI_REAL_PRECISION, & MPI_REAL_PRECISION, &
...@@ -363,8 +340,8 @@ ...@@ -363,8 +340,8 @@
#else /* WITH_MPI */ #else /* WITH_MPI */
! carefull non-block recv data copy must be done at wait or send ! carefull non-block recv data copy must be done at wait or send
! hh_trans_real(1:nb*local_size,num_hh_vecs+1) = hh_send(1:nb*hh_cnt(iblk),1,iblk) ! hh_trans(1:nb*local_size,num_hh_vecs+1) = hh_send(1:nb*hh_cnt(iblk),1,iblk)
! hh_trans_complex(1:nb*local_size,num_hh_vecs+1) = hh_send(1:nb*hh_cnt(iblk),1,iblk)
#endif /* WITH_MPI */ #endif /* WITH_MPI */
num_hh_vecs = num_hh_vecs + local_size num_hh_vecs = num_hh_vecs + local_size
endif endif
...@@ -506,12 +483,7 @@ ...@@ -506,12 +483,7 @@
endif endif
#ifndef WITH_MPI #ifndef WITH_MPI
#if REALCASE == 1 startAddr = ubound(hh_trans,dim=2)
startAddr = ubound(hh_trans_real,dim=2)
#endif
#if COMPLEXCASE == 1
startAddr = ubound(hh_trans_complex,dim=2)
#endif
#endif /* WITH_MPI */ #endif /* WITH_MPI */
#ifdef WITH_OPENMP #ifdef WITH_OPENMP
...@@ -996,12 +968,7 @@ ...@@ -996,12 +968,7 @@
#else /* WITH_MPI */ #else /* WITH_MPI */
! do the post-poned irecv here ! do the post-poned irecv here
startAddr = startAddr - hh_cnt(iblk) startAddr = startAddr - hh_cnt(iblk)
#if REALCASE == 1 hh_trans(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
hh_trans_real(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
#endif
#if COMPLEXCASE == 1
hh_trans_complex(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
#endif
#endif /* WITH_MPI */ #endif /* WITH_MPI */
! Reset counter and increase destination row ! Reset counter and increase destination row
...@@ -1351,12 +1318,7 @@ ...@@ -1351,12 +1318,7 @@
#else /* WITH_MPI */ #else /* WITH_MPI */
! do the post-poned irecv here ! do the post-poned irecv here
startAddr = startAddr - hh_cnt(iblk) startAddr = startAddr - hh_cnt(iblk)
#if REALCASE == 1 hh_trans(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
hh_trans_real(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
#endif
#if COMPLEXCASE == 1
hh_trans_complex(1:nb,startAddr+1:startAddr+hh_cnt(iblk)) = hh_send(1:nb,1:hh_cnt(iblk),iblk)
#endif
#endif /* WITH_MPI */ #endif /* WITH_MPI */
! Reset counter and increase destination row ! Reset counter and increase destination row
......
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