Commit e1cc5755 authored by Victor Yu's avatar Victor Yu
Browse files

Sync ELPA with upstream

Added proper support for setting ill-conditioning threshold.
parent 7a9d8c2e
......@@ -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 "20200718")
SET(elsi_DATESTAMP "20200808")
### CMake modules ###
LIST(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake)
......
......@@ -16,7 +16,7 @@
!
!
! More information can be found here:
! http://elpa.rzg.mpg.de/
! http://elpa.mpcdf.mpg.de/
!
! ELPA is free software: you can redistribute it and/or modify
! it under the terms of the version 3 of the license of the
......
......@@ -205,7 +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
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -324,7 +324,6 @@ contains
wantDebug = debug == 1
do_useGPU = .false.
if (useGPU) then
call obj%timer%start("check_for_gpu")
......@@ -381,12 +380,12 @@ contains
q_actual => q(1:matrixRows,1:matrixCols)
else
allocate(q_dummy(1:matrixRows,1:matrixCols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 386, istat, errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 387, istat, errorMessage)
q_actual => q_dummy
endif
allocate(e(na), tau(na), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: e, tau", 404, istat, errorMessage)
call check_allocate_f("elpa1_template: e, tau", 401, istat, errorMessage)
! start the computations
! as default do all three steps (this might change at some point)
......@@ -428,9 +427,13 @@ contains
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&double&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&double&
&. Aborting..."
stop
endif
......@@ -498,11 +501,11 @@ contains
endif ! do_trans_ev
deallocate(e, tau, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 558, istat, errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 565, istat, errorMessage)
if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 562, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 569, istat, errorMessage)
endif
! restore original OpenMP settings
......@@ -596,7 +599,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
real(kind=c_float) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -715,7 +718,6 @@ contains
wantDebug = debug == 1
do_useGPU = .false.
if (useGPU) then
call obj%timer%start("check_for_gpu")
......@@ -772,12 +774,12 @@ contains
q_actual => q(1:matrixRows,1:matrixCols)
else
allocate(q_dummy(1:matrixRows,1:matrixCols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 386, istat, errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 387, istat, errorMessage)
q_actual => q_dummy
endif
allocate(e(na), tau(na), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: e, tau", 404, istat, errorMessage)
call check_allocate_f("elpa1_template: e, tau", 401, istat, errorMessage)
! start the computations
! as default do all three steps (this might change at some point)
......@@ -819,9 +821,13 @@ contains
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&single&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&single&
&. Aborting..."
stop
endif
......@@ -889,11 +895,11 @@ contains
endif ! do_trans_ev
deallocate(e, tau, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 558, istat, errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 565, istat, errorMessage)
if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 562, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 569, istat, errorMessage)
endif
! restore original OpenMP settings
......@@ -989,7 +995,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
real(kind=c_double) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -1108,7 +1114,6 @@ contains
wantDebug = debug == 1
do_useGPU = .false.
if (useGPU) then
call obj%timer%start("check_for_gpu")
......@@ -1165,7 +1170,7 @@ contains
q_actual => q(1:matrixRows,1:matrixCols)
else
allocate(q_dummy(1:matrixRows,1:matrixCols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 386, istat, errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 387, istat, errorMessage)
q_actual => q_dummy
endif
......@@ -1175,9 +1180,9 @@ contains
l_cols_nev = local_index(nev, my_pcol, np_cols, nblk, -1) ! Local columns corresponding to nev
allocate(q_real(l_rows,l_cols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_real", 401, istat, errorMessage)
call check_allocate_f("elpa1_template: q_real", 398, istat, errorMessage)
allocate(e(na), tau(na), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: e, tau", 404, istat, errorMessage)
call check_allocate_f("elpa1_template: e, tau", 401, istat, errorMessage)
! start the computations
! as default do all three steps (this might change at some point)
......@@ -1219,9 +1224,13 @@ contains
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&double&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&double&
&. Aborting..."
stop
endif
......@@ -1290,14 +1299,14 @@ contains
endif ! do_trans_ev
deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_real", 554, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_real", 561, istat, errorMessage)
deallocate(e, tau, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 558, istat, errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 565, istat, errorMessage)
if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 562, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 569, istat, errorMessage)
endif
! restore original OpenMP settings
......@@ -1393,7 +1402,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
real(kind=c_float) :: thres_pd
logical :: do_tridiag, do_solve, do_trans_ev
integer(kind=ik) :: nrThreads
......@@ -1512,7 +1521,6 @@ contains
wantDebug = debug == 1
do_useGPU = .false.
if (useGPU) then
call obj%timer%start("check_for_gpu")
......@@ -1569,7 +1577,7 @@ contains
q_actual => q(1:matrixRows,1:matrixCols)
else
allocate(q_dummy(1:matrixRows,1:matrixCols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 386, istat, errorMessage)
call check_allocate_f("elpa1_template: q_dummy", 387, istat, errorMessage)
q_actual => q_dummy
endif
......@@ -1579,9 +1587,9 @@ contains
l_cols_nev = local_index(nev, my_pcol, np_cols, nblk, -1) ! Local columns corresponding to nev
allocate(q_real(l_rows,l_cols), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: q_real", 401, istat, errorMessage)
call check_allocate_f("elpa1_template: q_real", 398, istat, errorMessage)
allocate(e(na), tau(na), stat=istat, errmsg=errorMessage)
call check_allocate_f("elpa1_template: e, tau", 404, istat, errorMessage)
call check_allocate_f("elpa1_template: e, tau", 401, istat, errorMessage)
! start the computations
! as default do all three steps (this might change at some point)
......@@ -1623,9 +1631,13 @@ contains
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&single&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&single&
&. Aborting..."
stop
endif
......@@ -1694,14 +1706,14 @@ contains
endif ! do_trans_ev
deallocate(q_real, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_real", 554, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_real", 561, istat, errorMessage)
deallocate(e, tau, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 558, istat, errorMessage)
call check_deallocate_f("elpa1_template: e, tau", 565, istat, errorMessage)
if (obj%eigenvalues_only) then
deallocate(q_dummy, stat=istat, errmsg=errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 562, istat, errorMessage)
call check_deallocate_f("elpa1_template: q_dummy", 569, istat, errorMessage)
endif
! restore original OpenMP settings
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -68,10 +68,12 @@ module elpa_abstract_impl
type(c_ptr) :: index = C_NULL_PTR
logical :: eigenvalues_only
contains
procedure, public :: elpa_set_integer !< private methods to implement the setting of an integer/double key/value pair
procedure, public :: elpa_set_integer !< private methods to implement the setting of an integer/float/double key/value pair
procedure, public :: elpa_set_float
procedure, public :: elpa_set_double
procedure, public :: elpa_get_integer !< private methods to implement the querry of an integer/double key/value pair
procedure, public :: elpa_get_integer !< private methods to implement the querry of an integer/float/double key/value pair
procedure, public :: elpa_get_float
procedure, public :: elpa_get_double
end type
......@@ -118,6 +120,45 @@ contains
error = actual_error
end subroutine
!> \brief internal subroutine to set a float key/value pair
!> Parameters
!> \param self the allocated ELPA object
!> \param name string, the key
!> \param value float, the value to be set
!> \result error integer, the error code
subroutine elpa_set_float(self, name, value, error)
use, intrinsic :: iso_c_binding
use elpa_utilities, only : error_unit
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_float), intent(in) :: value
integer :: actual_error
integer :: error
actual_error = elpa_index_set_float_value_c(self%index, name // c_null_char, value)
error = actual_error
end subroutine
!> \brief internal subroutine to get an float key/value pair
!> Parameters
!> \param self the allocated ELPA object
!> \param name string, the key
!> \param value float, the value of the key/vaue pair
!> \param error integer, optional, to store an error code
subroutine elpa_get_float(self, name, value, error)
use, intrinsic :: iso_c_binding
use elpa_utilities, only : error_unit
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_float) :: value
integer, intent(out) :: error
integer :: actual_error
value = elpa_index_get_float_value_c(self%index, name // c_null_char, actual_error)
error = actual_error
end subroutine
!> \brief internal subroutine to set a double key/value pair
!> Parameters
!> \param self the allocated ELPA object
......
......@@ -111,12 +111,14 @@ module elpa_api
procedure(elpa_destroy_i), deferred, public :: destroy !< method to destroy an ELPA object
! key/value store
generic, public :: set => & !< export a method to set integer/double key/values
generic, public :: set => & !< export a method to set integer/double/float key/values
elpa_set_integer, &
elpa_set_float, &
elpa_set_double
generic, public :: get => & !< export a method to get integer/double key/values
generic, public :: get => & !< export a method to get integer/double/float key/values
elpa_get_integer, &
elpa_get_float, &
elpa_get_double
procedure(elpa_is_set_i), deferred, public :: is_set !< method to check whether key/value is set
......@@ -201,9 +203,11 @@ module elpa_api
!> \brief These method have to be public, in order to be overrideable in the extension types
procedure(elpa_set_integer_i), deferred, public :: elpa_set_integer
procedure(elpa_set_float_i), deferred, public :: elpa_set_float
procedure(elpa_set_double_i), deferred, public :: elpa_set_double
procedure(elpa_get_integer_i), deferred, public :: elpa_get_integer
procedure(elpa_get_float_i), deferred, public :: elpa_get_float
procedure(elpa_get_double_i), deferred, public :: elpa_get_double
procedure(elpa_eigenvectors_d_i), deferred, public :: elpa_eigenvectors_d
......@@ -372,7 +376,6 @@ module elpa_api
end function
end interface
!> \brief abstract definition of the autotune set_best method
!> Parameters
!> \details
......@@ -391,7 +394,6 @@ module elpa_api
end subroutine
end interface
!> \brief abstract definition of the autotune print best method
!> Parameters
!> \details
......@@ -539,6 +541,44 @@ module elpa_api
end function
end interface
!> \brief abstract definition of set method for float values
!> Parameters
!> \details
!> \param self class(elpa_t): the ELPA object
!> \param name string: the name of the key
!? \param value float: the value to associate with the key
!> \param error integer. optional : error code, which can be queried with elpa_strerr
abstract interface
subroutine elpa_set_float_i(self, name, value, error)
use, intrinsic :: iso_c_binding
import elpa_t
implicit none
class(elpa_t) :: self
character(*), intent(in) :: name
real(kind=c_float), intent(in) :: value
integer :: error
end subroutine
end interface
!> \brief abstract definition of get method for float values
!> Parameters
!> \details
!> \param self class(elpa_t): the ELPA object
!> \param name string: the name of the key
!> \param value float: the value associated with the key
!> \param error integer, optional : error code, which can be queried with elpa_strerr
abstract interface
subroutine elpa_get_float_i(self, name, value, error)
use, intrinsic :: iso_c_binding
import elpa_t
implicit none
class(elpa_t) :: self
character(*), intent(in) :: name
real(kind=c_float) :: value
integer, intent(out) :: error
end subroutine
end interface
!> \brief abstract definition of set method for double values
!> Parameters
!> \details
......@@ -2184,7 +2224,6 @@ module elpa_api
end subroutine
end interface
!> \brief abstract definition of interface to destroy the autotuning state
!> Parameters
!> \param self class(elpa_autotune_t): the ELPA autotune object
......
......@@ -104,6 +104,42 @@ module elpa_generated_fortran_interfaces
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_float_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int), intent(out) :: success
real(kind=c_float) :: value
end function
end interface
interface
function elpa_index_set_float_value_c(index, name, value) result(success) &
bind(C, name="elpa_index_set_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
real(kind=c_float),intent(in), value :: value
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_float_value_is_set_c(index, name) result(success) &
bind(C, name="elpa_index_float_value_is_set")
import c_ptr, c_int, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_get_float_loc_c(index, name) result(loc) bind(C, name="elpa_index_get_float_loc")
import c_ptr, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_double_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_double_value")
import c_ptr, c_int, c_double, c_char
......
......@@ -198,6 +198,42 @@ module elpa_generated_fortran_interfaces
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_float_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int), intent(out) :: success
real(kind=c_float) :: value
end function
end interface
interface
function elpa_index_set_float_value_c(index, name, value) result(success) &
bind(C, name="elpa_index_set_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
real(kind=c_float),intent(in), value :: value
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_float_value_is_set_c(index, name) result(success) &
bind(C, name="elpa_index_float_value_is_set")
import c_ptr, c_int, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_get_float_loc_c(index, name) result(loc) bind(C, name="elpa_index_get_float_loc")
import c_ptr, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_double_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_double_value")
import c_ptr, c_int, c_double, c_char
......
......@@ -198,6 +198,42 @@ module elpa_generated_fortran_interfaces
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_float_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int), intent(out) :: success
real(kind=c_float) :: value
end function
end interface
interface
function elpa_index_set_float_value_c(index, name, value) result(success) &
bind(C, name="elpa_index_set_float_value")
import c_ptr, c_int, c_float, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
real(kind=c_float),intent(in), value :: value
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_float_value_is_set_c(index, name) result(success) &
bind(C, name="elpa_index_float_value_is_set")
import c_ptr, c_int, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
integer(kind=c_int) :: success
end function
end interface
interface
function elpa_index_get_float_loc_c(index, name) result(loc) bind(C, name="elpa_index_get_float_loc")
import c_ptr, c_char
type(c_ptr), value :: index
character(kind=c_char), intent(in) :: name(*)
type(c_ptr) :: loc
end function
end interface
interface
function elpa_index_get_double_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_double_value")
import c_ptr, c_int, c_double, c_char
......
......@@ -252,6 +252,42 @@ module elpa_generated_fortran_interfaces
type(c_ptr) :: loc