Commit 77cd3307 authored by Andreas Marek's avatar Andreas Marek

Merge branch 'master' of gitlab.mpcdf.mpg.de:elpa/elpa

parents c2b2dfa9 768db157
...@@ -84,9 +84,10 @@ enum ELPA_COMPLEX_KERNELS { ...@@ -84,9 +84,10 @@ enum ELPA_COMPLEX_KERNELS {
X(ELPA_OK, 0) \ X(ELPA_OK, 0) \
X(ELPA_ERROR, -1) \ X(ELPA_ERROR, -1) \
X(ELPA_ERROR_ENTRY_NOT_FOUND, -2) \ X(ELPA_ERROR_ENTRY_NOT_FOUND, -2) \
X(ELPA_ERROR_INVALID_VALUE, -3) \ X(ELPA_ERROR_ENTRY_INVALID_VALUE, -3) \
X(ELPA_ERROR_VALUE_ALREADY_SET, -4) \ X(ELPA_ERROR_ENTRY_ALREADY_SET, -4) \
X(ELPA_ERROR_NO_STRING_REPRESENTATION, -5) X(ELPA_ERROR_ENTRY_NO_STRING_REPRESENTATION, -5) \
X(ELPA_ERROR_ENTRY_READONLY, -6)
enum ELPA_ERRORS { enum ELPA_ERRORS {
ELPA_FOR_ALL_ERRORS(ELPA_ENUM_ENTRY) ELPA_FOR_ALL_ERRORS(ELPA_ENUM_ENTRY)
......
...@@ -58,8 +58,7 @@ function elpa_solve_evp_& ...@@ -58,8 +58,7 @@ function elpa_solve_evp_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_1stage_& &_1stage_&
&PRECISION& &PRECISION&
&_impl (obj, a, ev, q, time_evp_fwd, & &_impl (obj, a, ev, q) result(success)
time_evp_solve, time_evp_back) result(success)
use precision use precision
use cuda_functions use cuda_functions
use mod_check_for_gpu use mod_check_for_gpu
...@@ -105,15 +104,11 @@ function elpa_solve_evp_& ...@@ -105,15 +104,11 @@ function elpa_solve_evp_&
logical :: useGPU logical :: useGPU
logical :: success logical :: success
real(kind=c_double) :: time_evp_fwd, &
time_evp_solve, time_evp_back
logical :: summary_timings
logical :: do_useGPU logical :: do_useGPU
integer(kind=ik) :: numberOfGPUDevices integer(kind=ik) :: numberOfGPUDevices
integer(kind=c_int) :: my_pe, n_pes, my_prow, my_pcol, mpierr integer(kind=c_int) :: my_pe, n_pes, my_prow, my_pcol, mpierr
real(kind=C_DATATYPE_KIND), allocatable :: e(:) real(kind=C_DATATYPE_KIND), allocatable :: e(:)
real(kind=c_double) :: ttt0, ttt1 ! MPI_WTIME always needs double
logical :: wantDebug logical :: wantDebug
integer(kind=c_int) :: istat integer(kind=c_int) :: istat
character(200) :: errorMessage character(200) :: errorMessage
...@@ -142,11 +137,11 @@ function elpa_solve_evp_& ...@@ -142,11 +137,11 @@ function elpa_solve_evp_&
else else
useGPU = .false. useGPU = .false.
endif endif
if (obj%get("summary_timings") .eq. 1) then ! if (obj%get("summary_timings") .eq. 1) then
summary_timings = .true. ! summary_timings = .true.
else ! else
summary_timings = .false. ! summary_timings = .false.
endif ! endif
call timer%start("mpi_communication") call timer%start("mpi_communication")
...@@ -228,17 +223,18 @@ function elpa_solve_evp_& ...@@ -228,17 +223,18 @@ function elpa_solve_evp_&
&" // ": error when allocating e, tau "//errorMessage &" // ": error when allocating e, tau "//errorMessage
stop 1 stop 1
endif endif
ttt0 = MPI_Wtime() ! ttt0 = MPI_Wtime()
call tridiag_& call tridiag_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
&PRECISION& &PRECISION&
& (na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, ev, e, tau, do_useGPU) & (na, a, lda, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, ev, e, tau, do_useGPU)
ttt1 = MPI_Wtime() !ttt1 = MPI_Wtime()
if(my_prow==0 .and. my_pcol==0 .and. summary_timings) write(error_unit,*) 'Time tridiag_real :',ttt1-ttt0 !if(my_prow==0 .and. my_pcol==0 .and. summary_timings) write(error_unit,*) 'Time tridiag_real :',ttt1-ttt0
time_evp_fwd = ttt1-ttt0 !time_evp_fwd = ttt1-ttt0
ttt0 = MPI_Wtime() !ttt0 = MPI_Wtime()
call solve_tridi_& call solve_tridi_&
&PRECISION& &PRECISION&
& (na, nev, ev, e, & & (na, nev, ev, e, &
...@@ -251,11 +247,6 @@ function elpa_solve_evp_& ...@@ -251,11 +247,6 @@ function elpa_solve_evp_&
nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug, success) nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, wantDebug, success)
if (.not.(success)) return if (.not.(success)) return
ttt1 = MPI_Wtime()
if(my_prow==0 .and. my_pcol==0 .and. summary_timings) write(error_unit,*) 'Time solve_tridi :',ttt1-ttt0
time_evp_solve = ttt1-ttt0
ttt0 = MPI_Wtime()
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
q(1:l_rows,1:l_cols_nev) = q_real(1:l_rows,1:l_cols_nev) q(1:l_rows,1:l_cols_nev) = q_real(1:l_rows,1:l_cols_nev)
#endif #endif
...@@ -264,9 +255,9 @@ function elpa_solve_evp_& ...@@ -264,9 +255,9 @@ function elpa_solve_evp_&
&_& &_&
&PRECISION& &PRECISION&
& (na, nev, a, lda, tau, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, do_useGPU) & (na, nev, a, lda, tau, q, ldq, nblk, matrixCols, mpi_comm_rows, mpi_comm_cols, do_useGPU)
ttt1 = MPI_Wtime() !ttt1 = MPI_Wtime()
if(my_prow==0 .and. my_pcol==0 .and. summary_timings) write(error_unit,*) 'Time trans_ev_real:',ttt1-ttt0 !if(my_prow==0 .and. my_pcol==0 .and. summary_timings) write(error_unit,*) 'Time trans_ev_real:',ttt1-ttt0
time_evp_back = ttt1-ttt0 !time_evp_back = ttt1-ttt0
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
deallocate(q_real, stat=istat, errmsg=errorMessage) deallocate(q_real, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
......
...@@ -163,13 +163,11 @@ function elpa_solve_evp_& ...@@ -163,13 +163,11 @@ function elpa_solve_evp_&
endif endif
endif endif
if (elpa_print_times) then call e%set("summary_timings", 1,successInternal)
call e%set("summary_timings", 1,successInternal) if (successInternal .ne. ELPA_OK) then
if (successInternal .ne. ELPA_OK) then print *, "Cannot set summary_timings"
print *, "Cannot set summary_timings" success = .false.
success = .false. return
return
endif
endif endif
call e%solve(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal) call e%solve(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal)
...@@ -180,11 +178,10 @@ function elpa_solve_evp_& ...@@ -180,11 +178,10 @@ function elpa_solve_evp_&
return return
endif endif
if (elpa_print_times) then time_evp_fwd = e%get_double("time_evp_fwd")
time_evp_fwd = e%get_double("time_evp_fwd") time_evp_solve = e%get_double("time_evp_solve")
time_evp_solve = e%get_double("time_evp_solve") time_evp_back = e%get_double("time_evp_back")
time_evp_back = e%get_double("time_evp_back")
endif
call elpa_deallocate(e) call elpa_deallocate(e)
call elpa_uninit() call elpa_uninit()
......
This diff is collapsed.
...@@ -109,7 +109,7 @@ module elpa2_impl ...@@ -109,7 +109,7 @@ module elpa2_impl
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param mpi_comm_all MPI communicator for the total processor set !> \param mpi_comm_all MPI communicator for the total processor set
!> !>
!> \param THIS_REAL_ELPA_KERNEL_API (optional) specify used ELPA2 kernel via API !> \param kernel specify ELPA2 kernel to use
!> !>
!> \param useQR (optional) use QR decomposition !> \param useQR (optional) use QR decomposition
!> \param useGPU (optional) decide whether to use GPUs or not !> \param useGPU (optional) decide whether to use GPUs or not
...@@ -157,7 +157,7 @@ module elpa2_impl ...@@ -157,7 +157,7 @@ module elpa2_impl
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param mpi_comm_all MPI communicator for the total processor set !> \param mpi_comm_all MPI communicator for the total processor set
!> !>
!> \param THIS_REAL_ELPA_KERNEL_API (optional) specify used ELPA2 kernel via API !> \param kernel specify ELPA2 kernel to use
!> !>
!> \param useQR (optional) use QR decomposition !> \param useQR (optional) use QR decomposition
!> \param useGPU (optional) decide whether GPUs should be used or not !> \param useGPU (optional) decide whether GPUs should be used or not
...@@ -205,7 +205,7 @@ module elpa2_impl ...@@ -205,7 +205,7 @@ module elpa2_impl
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param mpi_comm_all MPI communicator for the total processor set !> \param mpi_comm_all MPI communicator for the total processor set
!> !>
!> \param THIS_REAL_ELPA_KERNEL_API (optional) specify used ELPA2 kernel via API !> \param kernel specify ELPA2 kernel to use
!> \param useGPU (optional) decide whether GPUs should be used or not !> \param useGPU (optional) decide whether GPUs should be used or not
!> !>
!> \result success logical, false if error occured !> \result success logical, false if error occured
...@@ -252,8 +252,8 @@ module elpa2_impl ...@@ -252,8 +252,8 @@ module elpa2_impl
!> \param mpi_comm_cols MPI communicator for columns !> \param mpi_comm_cols MPI communicator for columns
!> \param mpi_comm_all MPI communicator for the total processor set !> \param mpi_comm_all MPI communicator for the total processor set
!> !>
!> \param THIS_COMPLEX_ELPA_KERNEL_API (optional) specify used ELPA2 kernel via API !> \param kernel specify ELPA2 kernel to use
!> \param useGPU (optional) decide whether GPUs should be used or not !> \param useGPU (optional) decide whether GPUs should be used or not
!> !>
!> \result success logical, false if error occured !> \result success logical, false if error occured
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
......
...@@ -54,8 +54,7 @@ ...@@ -54,8 +54,7 @@
&_& &_&
&2stage_& &2stage_&
&PRECISION& &PRECISION&
&_impl (obj, a, ev, q, & &_impl (obj, a, ev, q) result(success)
time_evp_fwd, time_evp_solve, time_evp_back) result(success)
#ifdef HAVE_DETAILED_TIMINGS #ifdef HAVE_DETAILED_TIMINGS
use timings use timings
...@@ -99,10 +98,7 @@ ...@@ -99,10 +98,7 @@
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
real(kind=C_DATATYPE_KIND), allocatable :: q_real(:,:) real(kind=C_DATATYPE_KIND), allocatable :: q_real(:,:)
#endif #endif
real(kind=c_double) :: time_evp_fwd, time_evp_solve, time_evp_back
logical :: summary_timings
integer(kind=c_intptr_t) :: tmat_dev, q_dev, a_dev integer(kind=c_intptr_t) :: tmat_dev, q_dev, a_dev
real(kind=c_double) :: ttt0, ttt1, ttts ! MPI_WTIME always needs double
integer(kind=c_int) :: i integer(kind=c_int) :: i
logical :: success, successCUDA logical :: success, successCUDA
...@@ -158,11 +154,11 @@ ...@@ -158,11 +154,11 @@
mpi_comm_cols = obj%get("mpi_comm_cols") mpi_comm_cols = obj%get("mpi_comm_cols")
mpi_comm_all = obj%get("mpi_comm_parent") mpi_comm_all = obj%get("mpi_comm_parent")
if (obj%get("summary_timings") .eq. 1) then ! if (obj%get("summary_timings") .eq. 1) then
summary_timings = .true. ! summary_timings = .true.
else ! else
summary_timings = .false. ! summary_timings = .false.
endif ! endif
if (obj%get("gpu") .eq. 1) then if (obj%get("gpu") .eq. 1) then
useGPU = .true. useGPU = .true.
else else
...@@ -271,8 +267,6 @@ ...@@ -271,8 +267,6 @@
success = .false. success = .false.
return return
endif endif
ttts = MPI_Wtime()
else else
! Choose bandwidth, must be a multiple of nblk, set to a value >= 32 ! Choose bandwidth, must be a multiple of nblk, set to a value >= 32
...@@ -303,9 +297,6 @@ ...@@ -303,9 +297,6 @@
endif endif
! Reduction full -> band ! Reduction full -> band
ttt0 = MPI_Wtime()
ttts = ttt0
call bandred_& call bandred_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
...@@ -318,13 +309,6 @@ ...@@ -318,13 +309,6 @@
#endif #endif
) )
if (.not.(success)) return if (.not.(success)) return
ttt1 = MPI_Wtime()
if (my_prow==0 .and. my_pcol==0 .and. summary_timings) &
write(error_unit,*) "Time " // "bandred_&
&MATH_DATATYPE&
&_&
&PRECISION " // " :",ttt1-ttt0
end if ! matrix not already banded on input end if ! matrix not already banded on input
! Reduction band -> tridiagonal ! Reduction band -> tridiagonal
...@@ -338,29 +322,18 @@ ...@@ -338,29 +322,18 @@
stop 1 stop 1
endif endif
ttt0 = MPI_Wtime()
call tridiag_band_& call tridiag_band_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
&PRECISION& &PRECISION&
(na, nbw, nblk, a, a_dev, lda, ev, e, matrixCols, hh_trans, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, do_useGPU) (na, nbw, nblk, a, a_dev, lda, ev, e, matrixCols, hh_trans, mpi_comm_rows, mpi_comm_cols, mpi_comm_all, do_useGPU)
ttt1 = MPI_Wtime()
if (my_prow==0 .and. my_pcol==0 .and. summary_timings) &
write(error_unit,*) "Time " // "tridiag_band_&
&MATH_DATATYPE&
&_&
&PRECISION " // " :",ttt1-ttt0
#ifdef WITH_MPI #ifdef WITH_MPI
call timer%start("mpi_communication") call timer%start("mpi_communication")
call mpi_bcast(ev, na, MPI_REAL_PRECISION, 0, mpi_comm_all, mpierr) call mpi_bcast(ev, na, MPI_REAL_PRECISION, 0, mpi_comm_all, mpierr)
call mpi_bcast(e, na, MPI_REAL_PRECISION, 0, mpi_comm_all, mpierr) call mpi_bcast(e, na, MPI_REAL_PRECISION, 0, mpi_comm_all, mpierr)
call timer%stop("mpi_communication") call timer%stop("mpi_communication")
#endif /* WITH_MPI */ #endif /* WITH_MPI */
ttt1 = MPI_Wtime()
time_evp_fwd = ttt1-ttts
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
l_rows = local_index(na, my_prow, np_rows, nblk, -1) ! Local rows of a and q l_rows = local_index(na, my_prow, np_rows, nblk, -1) ! Local rows of a and q
...@@ -377,8 +350,6 @@ ...@@ -377,8 +350,6 @@
#endif #endif
! Solve tridiagonal system ! Solve tridiagonal system
ttt0 = MPI_Wtime()
call solve_tridi_& call solve_tridi_&
&PRECISION & &PRECISION &
(na, nev, ev, e, & (na, nev, ev, e, &
...@@ -392,12 +363,6 @@ ...@@ -392,12 +363,6 @@
if (.not.(success)) return if (.not.(success)) return
ttt1 = MPI_Wtime()
if (my_prow==0 .and. my_pcol==0 .and. summary_timings) &
write(error_unit,*) 'Time solve_tridi :',ttt1-ttt0
time_evp_solve = ttt1-ttt0
ttts = ttt1
deallocate(e, stat=istat, errmsg=errorMessage) deallocate(e, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"solve_evp_& print *,"solve_evp_&
...@@ -418,9 +383,6 @@ ...@@ -418,9 +383,6 @@
endif endif
#endif #endif
! Backtransform stage 1 ! Backtransform stage 1
ttt0 = MPI_Wtime()
call trans_ev_tridi_to_band_& call trans_ev_tridi_to_band_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
...@@ -428,15 +390,9 @@ ...@@ -428,15 +390,9 @@
(na, nev, nblk, nbw, q, & (na, nev, nblk, nbw, q, &
q_dev, & q_dev, &
ldq, matrixCols, hh_trans, mpi_comm_rows, mpi_comm_cols, wantDebug, do_useGPU_trans_ev_tridi, & ldq, matrixCols, hh_trans, mpi_comm_rows, mpi_comm_cols, wantDebug, do_useGPU_trans_ev_tridi, &
summary_timings, success, kernel) summary_timings=.false., success=success, kernel=kernel)
if (.not.(success)) return if (.not.(success)) return
ttt1 = MPI_Wtime()
if (my_prow==0 .and. my_pcol==0 .and. summary_timings) &
write(error_unit,*) "Time " // "trans_ev_tridi_to_band_&
&MATH_DATATYPE&
&_&
&PRECISION " // " :",ttt1-ttt0
! We can now deallocate the stored householder vectors ! We can now deallocate the stored householder vectors
deallocate(hh_trans, stat=istat, errmsg=errorMessage) deallocate(hh_trans, stat=istat, errmsg=errorMessage)
...@@ -448,10 +404,7 @@ ...@@ -448,10 +404,7 @@
stop 1 stop 1
endif endif
if( bandwidth .ne. -1) then if( bandwidth == -1) then
time_evp_back = ttt1-ttts
else
if ( (do_useGPU) .and. .not.(do_useGPU_trans_ev_tridi) ) then if ( (do_useGPU) .and. .not.(do_useGPU_trans_ev_tridi) ) then
! copy to device if we want to continue on GPU ! copy to device if we want to continue on GPU
successCUDA = cuda_malloc(q_dev, ldq*matrixCols*size_of_datatype) successCUDA = cuda_malloc(q_dev, ldq*matrixCols*size_of_datatype)
...@@ -460,7 +413,6 @@ ...@@ -460,7 +413,6 @@
endif endif
! Backtransform stage 2 ! Backtransform stage 2
ttt0 = MPI_Wtime()
call trans_ev_band_to_full_& call trans_ev_band_to_full_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
...@@ -474,15 +426,6 @@ ...@@ -474,15 +426,6 @@
#endif #endif
) )
ttt1 = MPI_Wtime()
if (my_prow==0 .and. my_pcol==0 .and. summary_timings) &
write(error_unit,*) "Time " // "trans_ev_band_to_full_&
&MATH_DATATYPE&
&_&
&PRECISION " // " :",ttt1-ttt0
time_evp_back = ttt1-ttts
deallocate(tmat, stat=istat, errmsg=errorMessage) deallocate(tmat, stat=istat, errmsg=errorMessage)
if (istat .ne. 0) then if (istat .ne. 0) then
print *,"solve_evp_& print *,"solve_evp_&
......
...@@ -198,13 +198,11 @@ ...@@ -198,13 +198,11 @@
endif endif
#endif #endif
if (elpa_print_times) then call e%set("summary_timings", 1,successInternal)
call e%set("summary_timings", 1,successInternal) if (successInternal .ne. ELPA_OK) then
if (successInternal .ne. ELPA_OK) then print *, "Cannot set summary_timings"
print *, "Cannot set summary_timings" success = .false.
success = .false. return
return
endif
endif endif
call e%solve(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal) call e%solve(a(1:lda,1:matrixCols), ev, q(1:ldq,1:matrixCols), successInternal)
...@@ -214,11 +212,9 @@ ...@@ -214,11 +212,9 @@
return return
endif endif
if (elpa_print_times) then time_evp_fwd = e%get_double("time_evp_fwd")
time_evp_fwd = e%get_double("time_evp_fwd") time_evp_solve = e%get_double("time_evp_solve")
time_evp_solve = e%get_double("time_evp_solve") time_evp_back = e%get_double("time_evp_back")
time_evp_back = e%get_double("time_evp_back")
endif
call elpa_deallocate(e) call elpa_deallocate(e)
......
...@@ -179,15 +179,14 @@ module elpa_impl ...@@ -179,15 +179,14 @@ module elpa_impl
integer, optional :: error integer, optional :: error
integer :: actual_error integer :: actual_error
actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value) actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then if (present(error)) then
error = actual_error error = actual_error
else if (actual_error /= ELPA_OK) then else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,a,a,i0,a)') "ELPA: Error setting option '", name, "' to value ", value, & write(error_unit,'(a,i0,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" and you did not check for errors!" " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if end if
end subroutine end subroutine
...@@ -195,13 +194,20 @@ module elpa_impl ...@@ -195,13 +194,20 @@ module elpa_impl
function elpa_get_integer(self, name, error) result(value) function elpa_get_integer(self, name, error) result(value)
use iso_c_binding use iso_c_binding
use elpa_generated_fortran_interfaces use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self class(elpa_impl_t) :: self
character(*), intent(in) :: name character(*), intent(in) :: name
integer(kind=c_int) :: value integer(kind=c_int) :: value
integer, intent(out), optional :: error integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_int_value_c(self%index, name // c_null_char, error) value = elpa_index_get_int_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end function end function
...@@ -268,15 +274,13 @@ module elpa_impl ...@@ -268,15 +274,13 @@ module elpa_impl
integer, optional :: error integer, optional :: error
integer :: actual_error integer :: actual_error
actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value) actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then if (present(error)) then
error = actual_error error = actual_error
else if (actual_error /= ELPA_OK) then else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,a,es12.5,a)') "ELPA: Error setting option '", name, "' to value ", value, & write(error_unit,'(a,es12.5,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" and you did not check for errors!" " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if end if
end subroutine end subroutine
...@@ -284,13 +288,20 @@ module elpa_impl ...@@ -284,13 +288,20 @@ module elpa_impl
function elpa_get_double(self, name, error) result(value) function elpa_get_double(self, name, error) result(value)
use iso_c_binding use iso_c_binding
use elpa_generated_fortran_interfaces use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self class(elpa_impl_t) :: self
character(*), intent(in) :: name character(*), intent(in) :: name
real(kind=c_double) :: value real(kind=c_double) :: value
integer, intent(out), optional :: error integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_double_value_c(self%index, name // c_null_char, error) value = elpa_index_get_double_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end function end function
...@@ -327,21 +338,16 @@ module elpa_impl ...@@ -327,21 +338,16 @@ module elpa_impl
#endif #endif
real(kind=c_double) :: ev(self%na) real(kind=c_double) :: ev(self%na)
real(kind=c_double) :: time_evp_fwd, time_evp_solve, time_evp_back
integer, optional :: error integer, optional :: error
integer(kind=c_int) :: error_actual integer(kind=c_int) :: error_actual
logical :: success_l logical :: success_l
if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then