Commit b42ae17d authored by Victor Yu's avatar Victor Yu

Merge branch 'elpa_check_illcond' into 'master'

Avoid unnecessary calculation of eigenvectors

See merge request elsi-devel/elsi-interface!241
parents 1534aca7 358bab77
...@@ -7,7 +7,7 @@ SET(elsi_URL "http://elsi-interchange.org") ...@@ -7,7 +7,7 @@ SET(elsi_URL "http://elsi-interchange.org")
SET(elsi_EMAIL "elsi-team@duke.edu") SET(elsi_EMAIL "elsi-team@duke.edu")
SET(elsi_LICENSE "BSD 3") SET(elsi_LICENSE "BSD 3")
SET(elsi_DESCRIPTION "Electronic Structure Infrastructure") SET(elsi_DESCRIPTION "Electronic Structure Infrastructure")
SET(elsi_DATESTAMP "20200625") SET(elsi_DATESTAMP "20200629")
### CMake modules ### ### CMake modules ###
LIST(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) LIST(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
......
# ELSI - ELectronic Structure Infrastructure (v2.6.1) # ELSI - ELectronic Structure Infrastructure (development)
## About ## About
......
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
\begin{document} \begin{document}
% Title % Title
\title{\includegraphics[scale=0.07]{elsi_logo.png}\\ \vspace{0.5cm} \textbf{ELSI Interface Users' Guide\\ v2.6.1}} \title{\includegraphics[scale=0.07]{elsi_logo.png}\\ \vspace{0.5cm} \textbf{ELSI Interface Users' Guide}}
\author{The ELSI Team\\ \url{http://elsi-interchange.org}} \author{The ELSI Team\\ \url{http://elsi-interchange.org}}
\maketitle \maketitle
......
...@@ -205,6 +205,7 @@ contains ...@@ -205,6 +205,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads integer(kind=ik) :: nrThreads
...@@ -427,9 +428,15 @@ contains ...@@ -427,9 +428,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -589,6 +596,7 @@ contains ...@@ -589,6 +596,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads integer(kind=ik) :: nrThreads
...@@ -811,9 +819,15 @@ contains ...@@ -811,9 +819,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -975,6 +989,7 @@ contains ...@@ -975,6 +989,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads integer(kind=ik) :: nrThreads
...@@ -1204,9 +1219,15 @@ contains ...@@ -1204,9 +1219,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -1372,6 +1393,7 @@ contains ...@@ -1372,6 +1393,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads integer(kind=ik) :: nrThreads
...@@ -1601,9 +1623,15 @@ contains ...@@ -1601,9 +1623,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
......
...@@ -172,6 +172,7 @@ contains ...@@ -172,6 +172,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, & logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full do_trans_to_band, do_trans_to_full
...@@ -618,9 +619,15 @@ contains ...@@ -618,9 +619,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -734,11 +741,14 @@ contains ...@@ -734,11 +741,14 @@ contains
) )
endif endif
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
call obj%timer%stop("trans_ev_to_full") call obj%timer%stop("trans_ev_to_full")
endif ! do_trans_to_full endif ! do_trans_to_full
if (allocated(tmat)) then
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
endif
if (obj%eigenvalues_only) then if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage) deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage) call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
...@@ -865,6 +875,7 @@ contains ...@@ -865,6 +875,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, & logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full do_trans_to_band, do_trans_to_full
...@@ -1328,9 +1339,15 @@ contains ...@@ -1328,9 +1339,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -1444,11 +1461,14 @@ contains ...@@ -1444,11 +1461,14 @@ contains
) )
endif endif
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
call obj%timer%stop("trans_ev_to_full") call obj%timer%stop("trans_ev_to_full")
endif ! do_trans_to_full endif ! do_trans_to_full
if (allocated(tmat)) then
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
endif
if (obj%eigenvalues_only) then if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage) deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage) call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
...@@ -1573,6 +1593,7 @@ contains ...@@ -1573,6 +1593,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, & logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full do_trans_to_band, do_trans_to_full
...@@ -1998,9 +2019,15 @@ contains ...@@ -1998,9 +2019,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -2019,7 +2046,9 @@ contains ...@@ -2019,7 +2046,9 @@ contains
! q must be given thats why from here on we can use q and not q_actual ! q must be given thats why from here on we can use q and not q_actual
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
if (allocated(q_real)) then
deallocate(q_real, stat=istat, errmsg=errorMessage) deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage) call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage)
endif endif
...@@ -2118,11 +2147,14 @@ contains ...@@ -2118,11 +2147,14 @@ contains
) )
endif endif
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
call obj%timer%stop("trans_ev_to_full") call obj%timer%stop("trans_ev_to_full")
endif ! do_trans_to_full endif ! do_trans_to_full
if (allocated(tmat)) then
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
endif
if (obj%eigenvalues_only) then if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage) deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage) call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
...@@ -2247,6 +2279,7 @@ contains ...@@ -2247,6 +2279,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, & integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, & mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, & logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full do_trans_to_band, do_trans_to_full
...@@ -2672,9 +2705,15 @@ contains ...@@ -2672,9 +2705,15 @@ contains
stop stop
endif endif
if (check_pd .eq. 1) then if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
stop
endif
check_pd = 0 check_pd = 0
do i = 1, na do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1 check_pd = check_pd + 1
endif endif
enddo enddo
...@@ -2693,7 +2732,9 @@ contains ...@@ -2693,7 +2732,9 @@ contains
! q must be given thats why from here on we can use q and not q_actual ! q must be given thats why from here on we can use q and not q_actual
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
if (allocated(q_real)) then
deallocate(q_real, stat=istat, errmsg=errorMessage) deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage) call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage)
endif endif
...@@ -2792,11 +2833,14 @@ contains ...@@ -2792,11 +2833,14 @@ contains
) )
endif endif
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
call obj%timer%stop("trans_ev_to_full") call obj%timer%stop("trans_ev_to_full")
endif ! do_trans_to_full endif ! do_trans_to_full
if (allocated(tmat)) then
deallocate(tmat, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: tmat", 980, istat, errorMessage)
endif
if (obj%eigenvalues_only) then if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage) deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage) call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
......
...@@ -244,9 +244,14 @@ static const elpa_index_int_entry_t int_entries[] = { ...@@ -244,9 +244,14 @@ static const elpa_index_int_entry_t int_entries[] = {
BASE_ENTRY(option_name, option_description, 0, 1, 0) \ BASE_ENTRY(option_name, option_description, 0, 1, 0) \
} }
#define DOUBLE_ENTRY(option_name, option_description, default, print_flag) \
{ \
BASE_ENTRY(option_name, option_description, 0, 0, print_flag), \
.default_value = default, \
}
static const elpa_index_double_entry_t double_entries[] = { static const elpa_index_double_entry_t double_entries[] = {
/* Empty for now */ DOUBLE_ENTRY("thres_pd", "Threshold to define ill-conditioning, default 0.00001", 0.00001, PRINT_YES),
READONLY_DOUBLE_ENTRY("dummy", "dummy"),
}; };
void elpa_index_free(elpa_index_t index) { void elpa_index_free(elpa_index_t index) {
......
...@@ -1015,10 +1015,18 @@ subroutine elsi_elpa_evec_real(ph,bh,mat,eval,evec,sing_check) ...@@ -1015,10 +1015,18 @@ subroutine elsi_elpa_evec_real(ph,bh,mat,eval,evec,sing_check)
copy(:,:) = mat copy(:,:) = mat
call ph%elpa_aux%set("thres_pd",ph%ill_tol,ierr)
if(ierr == 0) then
call ph%elpa_aux%set("check_pd",1,ierr)
end if
call ph%elpa_aux%eigenvectors(copy,eval,evec,ierr) call ph%elpa_aux%eigenvectors(copy,eval,evec,ierr)
call elsi_check_err(bh,"ELPA eigensolver",ierr,caller) call elsi_check_err(bh,"ELPA eigensolver",ierr,caller)
call ph%elpa_aux%set("check_pd",0,ierr)
call elsi_deallocate(bh,copy,"copy") call elsi_deallocate(bh,copy,"copy")
do i = 1,ph%n_basis do i = 1,ph%n_basis
...@@ -1106,10 +1114,18 @@ subroutine elsi_elpa_evec_cmplx(ph,bh,mat,eval,evec,sing_check) ...@@ -1106,10 +1114,18 @@ subroutine elsi_elpa_evec_cmplx(ph,bh,mat,eval,evec,sing_check)
copy(:,:) = mat copy(:,:) = mat
call ph%elpa_aux%set("thres_pd",ph%ill_tol,ierr)
if(ierr == 0) then
call ph%elpa_aux%set("check_pd",1,ierr)
end if
call ph%elpa_aux%eigenvectors(copy,eval,evec,ierr) call ph%elpa_aux%eigenvectors(copy,eval,evec,ierr)
call elsi_check_err(bh,"ELPA eigensolver",ierr,caller) call elsi_check_err(bh,"ELPA eigensolver",ierr,caller)
call ph%elpa_aux%set("check_pd",0,ierr)
call elsi_deallocate(bh,copy,"copy") call elsi_deallocate(bh,copy,"copy")
do i = 1,ph%n_basis do i = 1,ph%n_basis
......
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