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")
SET(elsi_EMAIL "elsi-team@duke.edu")
SET(elsi_LICENSE "BSD 3")
SET(elsi_DESCRIPTION "Electronic Structure Infrastructure")
SET(elsi_DATESTAMP "20200625")
SET(elsi_DATESTAMP "20200629")
### CMake modules ###
LIST(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
......
# ELSI - ELectronic Structure Infrastructure (v2.6.1)
# ELSI - ELectronic Structure Infrastructure (development)
## About
......
......@@ -21,7 +21,7 @@
\begin{document}
% 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}}
\maketitle
......
......@@ -205,6 +205,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -427,9 +428,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -589,6 +596,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -811,9 +819,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -975,6 +989,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -1204,9 +1219,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -1372,6 +1393,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, i, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -1601,9 +1623,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......
......@@ -172,6 +172,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full
......@@ -618,9 +619,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -734,11 +741,14 @@ contains
)
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")
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
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
......@@ -865,6 +875,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full
......@@ -1328,9 +1339,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -1444,11 +1461,14 @@ contains
)
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")
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
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
......@@ -1573,6 +1593,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full
......@@ -1998,9 +2019,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-11_rk8) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -2019,7 +2046,9 @@ contains
! 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)
endif
if (allocated(q_real)) then
deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage)
endif
......@@ -2118,11 +2147,14 @@ contains
)
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")
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
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_dummy", 989, istat, errorMessage)
......@@ -2247,6 +2279,7 @@ contains
integer(kind=ik) :: na, nev, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, &
mpi_comm_all, check_pd, error, matrixRows
real(kind=c_double) :: thres_pd
logical :: do_bandred, do_tridiag, do_solve_tridi, &
do_trans_to_band, do_trans_to_full
......@@ -2672,9 +2705,15 @@ contains
stop
endif
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
do i = 1, na
if (ev(i) .gt. 1e-4_rk4) then
if (ev(i) .gt. thres_pd) then
check_pd = check_pd + 1
endif
enddo
......@@ -2693,7 +2732,9 @@ contains
! 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)
endif
if (allocated(q_real)) then
deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa2_template: q_real", 863, istat, errorMessage)
endif
......@@ -2792,11 +2833,14 @@ contains
)
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")
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
deallocate(q_dummy, stat=istat, errmsg=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[] = {
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[] = {
/* Empty for now */
READONLY_DOUBLE_ENTRY("dummy", "dummy"),
DOUBLE_ENTRY("thres_pd", "Threshold to define ill-conditioning, default 0.00001", 0.00001, PRINT_YES),
};
void elpa_index_free(elpa_index_t index) {
......
......@@ -1015,10 +1015,18 @@ subroutine elsi_elpa_evec_real(ph,bh,mat,eval,evec,sing_check)
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 elsi_check_err(bh,"ELPA eigensolver",ierr,caller)
call ph%elpa_aux%set("check_pd",0,ierr)
call elsi_deallocate(bh,copy,"copy")
do i = 1,ph%n_basis
......@@ -1106,10 +1114,18 @@ subroutine elsi_elpa_evec_cmplx(ph,bh,mat,eval,evec,sing_check)
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 elsi_check_err(bh,"ELPA eigensolver",ierr,caller)
call ph%elpa_aux%set("check_pd",0,ierr)
call elsi_deallocate(bh,copy,"copy")
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