Commit e56cf139 authored by Andreas Marek's avatar Andreas Marek

Merge branch 'fixes' into 'matrix_redistribute'

Fixes

See merge request !30
parents 2b2bb0d2 3e2b1128
......@@ -80,8 +80,8 @@
#include "../general/precision_kinds.F90"
class(elpa_abstract_impl_t), intent(inout) :: obj
real(kind=rk) :: g_col(nlen), l_col(*) ! chnage this to proper 2d 1d matching ! remove assumed size
integer(kind=ik) :: noff, nlen, my_prow, np_rows, nblk
real(kind=rk) :: g_col(nlen), l_col(*) ! chnage this to proper 2d 1d matching ! remove assumed size
integer(kind=ik) :: nbs, nbe, jb, g_off, l_off, js, je
......
......@@ -384,7 +384,7 @@
call obj%timer%start("blas")
call PRECISION_GEMM(BLAS_TRANS_OR_CONJ, 'N', int(nstor,kind=BLAS_KIND), &
int(lce-lcs+1,kind=BLAS_KIND), int(lre-lrs+1,kind=BLAS_KIND), &
ONE, aux_mat(lrs:l_rows,1:nblk_mult), int(ubound(aux_mat,dim=1),kind=BLAS_KIND), &
ONE, aux_mat(lrs:lre,1:nstor), int(lre-lrs+1,kind=BLAS_KIND), &
b(lrs,lcs), int(ldb,kind=BLAS_KIND), ZERO, tmp1, &
int(nstor,kind=BLAS_KIND))
call obj%timer%stop("blas")
......
......@@ -299,6 +299,13 @@
hvm = 0.0_rck ! Must be set to 0 !!!
hvb = 0.0_rck ! Safety only
tmp1 = 0.0_rck
tmp2 = 0.0_rck
tmat_complete = 0.0_rck
if (blocking_factor > 1) then
t_tmp = 0.0_rck ! Must be set to 0 !!!
t_tmp2 = 0.0_rck
endif
l_cols = local_index(nqc, my_pcol, np_cols, nblk, -1) ! Local columns of q_mat
do istep=1,((na-1)/nbw-1)/blocking_factor + 1
......@@ -485,7 +492,7 @@
call cublas_PRECISION_TRMM('L', 'U', BLAS_TRANS_OR_CONJ, 'N', &
n_cols, l_cols, ONE, tmat_dev, cwy_blocking, &
tmp_dev, n_cols)
call cublas_PRECISION_GEMM('N', 'N', l_rows, l_cols, n_cols, &
call cublas_PRECISION_GEMM('N', 'N', l_rows, l_cols, n_cols, &
-ONE, hvm_dev, max_local_rows, tmp_dev, n_cols, ONE, q_dev, ldq)
call obj%timer%stop("cublas")
else
......
......@@ -2139,7 +2139,13 @@
stop 1
endif
deallocate(result_recv_request, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
print *,"trans_ev_tridi_to_band_&
&MATH_DATATYPE&
&: error when deallocating result_recv_request "//errorMessage
stop 1
endif
deallocate(result_buffer, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then
......
......@@ -31,6 +31,13 @@ module elpa_autotune_impl
#else
integer, intent(out) :: error
#endif
! nothing to do atm
#ifdef USE_FORTRAN2008
if (present(error)) error = ELPA_OK
#else
error = ELPA_OK
#endif
end subroutine
!> \brief function to destroy an elpa autotune object
......
......@@ -695,15 +695,13 @@ module elpa_impl
call self%get("mpi_comm_cols", mpi_comm_cols,error)
if (check_elpa_get(error, ELPA_ERROR_SETUP)) return
process_rowMPI = int(process_row,kind=c_int)
call mpi_comm_rank(int(mpi_comm_rows,kind=MPI_KIND), process_rowMPI, mpierr)
process_row = int(process_rowMPI,kind=MPI_KIND)
process_row = int(process_rowMPI,kind=c_int)
call self%set("process_row", process_row, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
process_colMPI = int(process_col,kind=c_int)
call mpi_comm_rank(int(mpi_comm_cols,kind=MPI_KIND), process_colMPI, mpierr)
process_col = int(process_colMPI,kind=MPI_KIND)
process_col = int(process_colMPI,kind=c_int)
call self%set("process_col", process_col, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
......
......@@ -212,7 +212,7 @@
call self%get("solver", solver,error2)
call self%set("is_skewsymmetric",1)
call self%set("is_skewsymmetric",1,error2)
if (error2 .ne. ELPA_OK) then
print *,"Problem setting is_skewsymmetric. Aborting..."
#ifdef USE_FORTRAN2008
......@@ -503,7 +503,7 @@
logical :: success_l
call self%get("solver", solver,error2)
call self%set("is_skewsymmetric",1)
call self%set("is_skewsymmetric",1,error2)
if (error2 .ne. ELPA_OK) then
print *,"Problem getting solver option. Aborting..."
#ifdef USE_FORTRAN2008
......
......@@ -575,9 +575,9 @@ program test
assert_elpa_ok(error_elpa)
if (layout .eq. 'C') then
call e%set("matrix_order",COLUMN_MAJOR_ORDER)
call e%set("matrix_order",COLUMN_MAJOR_ORDER,error_elpa)
else
call e%set("matrix_order",ROW_MAJOR_ORDER)
call e%set("matrix_order",ROW_MAJOR_ORDER,error_elpa)
endif
#ifdef WITH_MPI
......
......@@ -210,9 +210,9 @@ program test
assert_elpa_ok(error_elpa)
if (layout .eq. 'C') then
call e%set("matrix_order",COLUMN_MAJOR_ORDER)
call e%set("matrix_order",COLUMN_MAJOR_ORDER,error_elpa)
else
call e%set("matrix_order",ROW_MAJOR_ORDER)
call e%set("matrix_order",ROW_MAJOR_ORDER,error_elpa)
endif
#ifdef WITH_MPI
......
......@@ -227,13 +227,13 @@ program test
as_complex(1:na_rows,1:na_cols) = a_complex(1:na_rows,1:na_cols)
! first set up and solve the brute force problem
e_complex => elpa_allocate()
e_complex => elpa_allocate(error_elpa)
call set_basic_params(e_complex, na, nev, na_rows, na_cols, my_prow, my_pcol)
call e_complex%set("timings",1, error_elpa)
call e_complex%set("debug",1)
call e_complex%set("gpu", 0)
call e_complex%set("debug",1,error_elpa)
call e_complex%set("gpu", 0,error_elpa)
call e_complex%set("omp_threads", 8, error_elpa)
assert_elpa_ok(e_complex%setup())
......@@ -265,13 +265,13 @@ program test
call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
#endif
! now run the skewsymmetric case
e_skewsymmetric => elpa_allocate()
e_skewsymmetric => elpa_allocate(error_elpa)
call set_basic_params(e_skewsymmetric, na, nev, na_rows, na_cols, my_prow, my_pcol)
call e_skewsymmetric%set("timings",1, error_elpa)
call e_skewsymmetric%set("debug",1)
call e_skewsymmetric%set("gpu", 0)
call e_skewsymmetric%set("debug",1,error_elpa)
call e_skewsymmetric%set("gpu", 0,error_elpa)
call e_skewsymmetric%set("omp_threads",8, error_elpa)
assert_elpa_ok(e_skewsymmetric%setup())
......@@ -331,8 +331,8 @@ program test
#ifdef WITH_MPI
call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
#endif
call elpa_deallocate(e_complex)
call elpa_deallocate(e_skewsymmetric)
call elpa_deallocate(e_complex,error_elpa)
call elpa_deallocate(e_skewsymmetric,error_elpa)
!to do
......@@ -348,7 +348,7 @@ program test
deallocate(as_skewsymmetric)
deallocate(z_skewsymmetric)
deallocate(ev_skewsymmetric)
call elpa_uninit()
call elpa_uninit(error_elpa)
......
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