Commit 681ab7bc authored by Andreas Marek's avatar Andreas Marek
Browse files

Convert get method from function to subroutine

parent 6a4cc5fb
...@@ -11,6 +11,18 @@ ...@@ -11,6 +11,18 @@
elpa_set_double \ elpa_set_double \
)(e, name, value, error) )(e, name, value, error)
/**
* \todo document elpa_get()
*/
#define elpa_get(e, name, value, error) _Generic((value), \
int*: \
elpa_get_integer, \
\
double*: \
elpa_get_double \
)(e, name, value, error)
/** /**
* \todo document elpa_solve() * \todo document elpa_solve()
*/ */
......
...@@ -104,7 +104,7 @@ function elpa_solve_evp_& ...@@ -104,7 +104,7 @@ function elpa_solve_evp_&
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(:)
logical :: wantDebug logical :: wantDebug
integer(kind=c_int) :: istat integer(kind=c_int) :: istat, debug, gpu
character(200) :: errorMessage character(200) :: errorMessage
integer(kind=ik) :: na, nev, lda, ldq, nblk, matrixCols, & integer(kind=ik) :: na, nev, lda, ldq, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, mpi_comm_all mpi_comm_rows, mpi_comm_cols, mpi_comm_all
...@@ -122,11 +122,12 @@ function elpa_solve_evp_& ...@@ -122,11 +122,12 @@ function elpa_solve_evp_&
nblk = obj%nblk nblk = obj%nblk
matrixCols = obj%local_ncols matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows",mpi_comm_rows)
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols",mpi_comm_cols)
mpi_comm_all = obj%get("mpi_comm_parent") call obj%get("mpi_comm_parent", mpi_comm_all)
if (obj%get("gpu") .eq. 1) then call obj%get("gpu",gpu)
if (gpu .eq. 1) then
useGPU =.true. useGPU =.true.
else else
useGPU = .false. useGPU = .false.
...@@ -148,7 +149,8 @@ function elpa_solve_evp_& ...@@ -148,7 +149,8 @@ function elpa_solve_evp_&
call obj%timer%stop("mpi_communication") call obj%timer%stop("mpi_communication")
success = .true. success = .true.
wantDebug = obj%get("debug") == 1 call obj%get("debug", debug)
wantDebug = debug == 1
do_useGPU = .false. do_useGPU = .false.
...@@ -169,7 +171,8 @@ function elpa_solve_evp_& ...@@ -169,7 +171,8 @@ function elpa_solve_evp_&
endif endif
else else
! check whether set by environment variable ! check whether set by environment variable
do_useGPU = obj%get("gpu") == 1 call obj%get("gpu", gpu)
do_useGPU = gpu == 1
if (do_useGPU) then if (do_useGPU) then
if (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then if (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then
......
...@@ -94,10 +94,11 @@ ...@@ -94,10 +94,11 @@
nblk = obj%nblk nblk = obj%nblk
matrixCols = obj%local_ncols matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows",mpi_comm_rows )
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols",mpi_comm_cols)
if (obj%get("debug") == 1) then call obj%get("debug",debug)
if (debug == 1) then
wantDebug = .true. wantDebug = .true.
else else
wantDebug = .false. wantDebug = .false.
......
...@@ -88,7 +88,7 @@ ...@@ -88,7 +88,7 @@
#endif #endif
logical :: wantDebug logical :: wantDebug
logical :: success logical :: success
integer(kind=ik) :: istat integer(kind=ik) :: istat, debug
character(200) :: errorMessage character(200) :: errorMessage
call obj%timer%start("elpa_invert_trm_& call obj%timer%start("elpa_invert_trm_&
...@@ -102,10 +102,11 @@ ...@@ -102,10 +102,11 @@
nblk = obj%nblk nblk = obj%nblk
matrixCols = obj%local_ncols matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows",mpi_comm_rows)
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols",mpi_comm_cols)
if (obj%get("debug") == 1) then call obj%get("debug", debug)
if (debug == 1) then
wantDebug = .true. wantDebug = .true.
else else
wantDebug = .true. wantDebug = .true.
......
...@@ -108,8 +108,8 @@ ...@@ -108,8 +108,8 @@
nblk = obj%nblk nblk = obj%nblk
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows",mpi_comm_rows)
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols",mpi_comm_cols)
success = .true. success = .true.
call obj%timer%start("mpi_communication") call obj%timer%start("mpi_communication")
......
...@@ -77,6 +77,8 @@ ...@@ -77,6 +77,8 @@
logical :: wantDebug logical :: wantDebug
logical :: success logical :: success
integer :: debug
call obj%timer%start("elpa_solve_tridi_public_& call obj%timer%start("elpa_solve_tridi_public_&
&MATH_DATATYPE& &MATH_DATATYPE&
&_& &_&
...@@ -88,10 +90,11 @@ ...@@ -88,10 +90,11 @@
ldq = obj%local_nrows ldq = obj%local_nrows
matrixCols = obj%local_ncols matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows", mpi_comm_rows)
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols", mpi_comm_cols)
if (obj%get("debug") == 1) then call obj%get("debug",debug)
if (debug == 1) then
wantDebug = .true. wantDebug = .true.
else else
wantDebug = .false. wantDebug = .false.
......
...@@ -97,7 +97,7 @@ ...@@ -97,7 +97,7 @@
integer(kind=c_int) :: i integer(kind=c_int) :: i
logical :: success, successCUDA logical :: success, successCUDA
logical :: wantDebug logical :: wantDebug
integer(kind=c_int) :: istat integer(kind=c_int) :: istat, gpu, debug, qr
character(200) :: errorMessage character(200) :: errorMessage
logical :: do_useGPU, do_useGPU_trans_ev_tridi logical :: do_useGPU, do_useGPU_trans_ev_tridi
integer(kind=c_int) :: numberOfGPUDevices integer(kind=c_int) :: numberOfGPUDevices
...@@ -122,40 +122,44 @@ ...@@ -122,40 +122,44 @@
matrixCols = obj%local_ncols matrixCols = obj%local_ncols
#if REALCASE == 1 #if REALCASE == 1
kernel = obj%get("real_kernel") call obj%get("real_kernel",kernel)
! check consistency between request for GPUs and defined kernel ! check consistency between request for GPUs and defined kernel
if (obj%get("gpu") == 1) then call obj%get("gpu", gpu)
if (gpu == 1) then
if (kernel .ne. ELPA_2STAGE_REAL_GPU) then if (kernel .ne. ELPA_2STAGE_REAL_GPU) then
write(error_unit,*) "ELPA: Warning, GPU usage has been requested but compute kernel is defined as non-GPU!" write(error_unit,*) "ELPA: Warning, GPU usage has been requested but compute kernel is defined as non-GPU!"
else if (obj%get("nblk") .ne. 128) then else if (nblk .ne. 128) then
kernel = ELPA_2STAGE_REAL_GENERIC kernel = ELPA_2STAGE_REAL_GENERIC
endif endif
endif endif
#endif #endif
#if COMPLEXCASE == 1 #if COMPLEXCASE == 1
kernel = obj%get("complex_kernel") call obj%get("complex_kernel",kernel)
! check consistency between request for GPUs and defined kernel ! check consistency between request for GPUs and defined kernel
if (obj%get("gpu") == 1) then call obj%get("gpu", gpu)
if (gpu == 1) then
if (kernel .ne. ELPA_2STAGE_COMPLEX_GPU) then if (kernel .ne. ELPA_2STAGE_COMPLEX_GPU) then
write(error_unit,*) "ELPA: Warning, GPU usage has been requested but compute kernel is defined as non-GPU!" write(error_unit,*) "ELPA: Warning, GPU usage has been requested but compute kernel is defined as non-GPU!"
else if (obj%get("nblk") .ne. 128) then else if (nblk .ne. 128) then
kernel = ELPA_2STAGE_COMPLEX_GENERIC kernel = ELPA_2STAGE_COMPLEX_GENERIC
endif endif
endif endif
#endif #endif
mpi_comm_rows = obj%get("mpi_comm_rows") call obj%get("mpi_comm_rows",mpi_comm_rows)
mpi_comm_cols = obj%get("mpi_comm_cols") call obj%get("mpi_comm_cols",mpi_comm_cols)
mpi_comm_all = obj%get("mpi_comm_parent") call obj%get("mpi_comm_parent",mpi_comm_all)
if (obj%get("gpu") .eq. 1) then call obj%get("gpu",gpu)
if (gpu .eq. 1) then
useGPU = .true. useGPU = .true.
else else
useGPU = .false. useGPU = .false.
endif endif
#if REALCASE == 1 #if REALCASE == 1
if (obj%get("qr") .eq. 1) then call obj%get("qr",qr)
if (qr .eq. 1) then
useQR = .true. useQR = .true.
else else
useQR = .false. useQR = .false.
...@@ -172,7 +176,8 @@ ...@@ -172,7 +176,8 @@
call mpi_comm_size(mpi_comm_cols,np_cols,mpierr) call mpi_comm_size(mpi_comm_cols,np_cols,mpierr)
call obj%timer%stop("mpi_communication") call obj%timer%stop("mpi_communication")
wantDebug = obj%get("debug") == 1 call obj%get("debug",debug)
wantDebug = debug == 1
success = .true. success = .true.
do_useGPU = .false. do_useGPU = .false.
...@@ -215,7 +220,8 @@ ...@@ -215,7 +220,8 @@
endif endif
else else
! check whether set by environment variable ! check whether set by environment variable
do_useGPU = obj%get("gpu") == 1 call obj%get("gpu",gpu)
do_useGPU = gpu == 1
if (do_useGPU) then if (do_useGPU) then
if (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then if (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then
...@@ -246,7 +252,7 @@ ...@@ -246,7 +252,7 @@
call obj%timer%start("bandred") call obj%timer%start("bandred")
if (obj%is_set("bandwidth") == 1) then if (obj%is_set("bandwidth") == 1) then
nbw=obj%get("bandwidth") call obj%get("bandwidth",nbw)
if ((nbw == 0) .or. (mod(nbw, nblk) .ne. 0)) then if ((nbw == 0) .or. (mod(nbw, nblk) .ne. 0)) then
if (wantDebug) then if (wantDebug) then
write(error_unit,*) "Specified bandwidth has to be a multiple of blocksize: ",nbw write(error_unit,*) "Specified bandwidth has to be a multiple of blocksize: ",nbw
......
...@@ -86,8 +86,10 @@ module elpa_api ...@@ -86,8 +86,10 @@ module elpa_api
generic, public :: set => & !< export a method to set integer/double key/values generic, public :: set => & !< export a method to set integer/double key/values
elpa_set_integer, & elpa_set_integer, &
elpa_set_double elpa_set_double
procedure(elpa_get_integer_i), deferred, public :: get !< get method for integer key/values
procedure(elpa_get_double_i), deferred, public :: get_double !< get method for double key/values generic, public :: get => & !< export a method to get integer/double key/values
elpa_get_integer, &
elpa_get_double
procedure(elpa_is_set_i), deferred, public :: is_set !< method to check whether key/value is set procedure(elpa_is_set_i), deferred, public :: is_set !< method to check whether key/value is set
procedure(elpa_can_set_i), deferred, public :: can_set !< method to check whether key/value can be set procedure(elpa_can_set_i), deferred, public :: can_set !< method to check whether key/value can be set
...@@ -131,6 +133,9 @@ module elpa_api ...@@ -131,6 +133,9 @@ module elpa_api
procedure(elpa_set_integer_i), deferred, private :: elpa_set_integer procedure(elpa_set_integer_i), deferred, private :: elpa_set_integer
procedure(elpa_set_double_i), deferred, private :: elpa_set_double procedure(elpa_set_double_i), deferred, private :: elpa_set_double
procedure(elpa_get_integer_i), deferred, private :: elpa_get_integer
procedure(elpa_get_double_i), deferred, private :: elpa_get_double
procedure(elpa_solve_d_i), deferred, private :: elpa_solve_d procedure(elpa_solve_d_i), deferred, private :: elpa_solve_d
procedure(elpa_solve_f_i), deferred, private :: elpa_solve_f procedure(elpa_solve_f_i), deferred, private :: elpa_solve_f
procedure(elpa_solve_dc_i), deferred, private :: elpa_solve_dc procedure(elpa_solve_dc_i), deferred, private :: elpa_solve_dc
...@@ -208,10 +213,10 @@ module elpa_api ...@@ -208,10 +213,10 @@ module elpa_api
!> \details !> \details
!> \param self class(elpa_t): the ELPA object !> \param self class(elpa_t): the ELPA object
!> \param name string: the name of the key !> \param name string: the name of the key
!> \param value integer : the value corresponding to the key
!> \param error integer, optional : error code, which can be queried with elpa_strerr() !> \param error integer, optional : error code, which can be queried with elpa_strerr()
!> \result value integer : the value corresponding to the key
abstract interface abstract interface
function elpa_get_integer_i(self, name, error) result(value) subroutine elpa_get_integer_i(self, name, value, error)
use iso_c_binding use iso_c_binding
import elpa_t import elpa_t
implicit none implicit none
...@@ -219,7 +224,7 @@ module elpa_api ...@@ -219,7 +224,7 @@ module elpa_api
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
end function end subroutine
end interface end interface
!> \brief abstract definition of is_set method for integer values !> \brief abstract definition of is_set method for integer values
...@@ -282,10 +287,10 @@ module elpa_api ...@@ -282,10 +287,10 @@ module elpa_api
!> \details !> \details
!> \param self class(elpa_t): the ELPA object !> \param self class(elpa_t): the ELPA object
!> \param name string: the name of the key !> \param name string: the name of the key
!> \param value double: the value associated with the key
!> \param error integer. optional : error code, which can be queried with elpa_strerr !> \param error integer. optional : error code, which can be queried with elpa_strerr
!> \result value double: the value associated with the key
abstract interface abstract interface
function elpa_get_double_i(self, name, error) result(value) subroutine elpa_get_double_i(self, name, value, error)
use iso_c_binding use iso_c_binding
import elpa_t import elpa_t
implicit none implicit none
...@@ -293,7 +298,7 @@ module elpa_api ...@@ -293,7 +298,7 @@ module elpa_api
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
end function end subroutine
end interface end interface
!> \brief abstract definition of associate method for integer pointers !> \brief abstract definition of associate method for integer pointers
......
...@@ -69,8 +69,6 @@ module elpa_impl ...@@ -69,8 +69,6 @@ module elpa_impl
procedure, public :: destroy => elpa_destroy !< a destroy method: implemented in elpa_destroy procedure, public :: destroy => elpa_destroy !< a destroy method: implemented in elpa_destroy
! KV store ! KV store
procedure, public :: get => elpa_get_integer !< a get method for integer key/values: implemented in elpa_get_integer
procedure, public :: get_double => elpa_get_double !< a get method for double key/values: implemented in elpa_get_double
procedure, public :: is_set => elpa_is_set !< a method to check whether a key/value pair has been set : implemented procedure, public :: is_set => elpa_is_set !< a method to check whether a key/value pair has been set : implemented
!< in elpa_is_set !< in elpa_is_set
procedure, public :: can_set => elpa_can_set !< a method to check whether a key/value pair can be set : implemented procedure, public :: can_set => elpa_can_set !< a method to check whether a key/value pair can be set : implemented
...@@ -87,6 +85,9 @@ module elpa_impl ...@@ -87,6 +85,9 @@ module elpa_impl
procedure, private :: elpa_set_integer !< private methods to implement the setting of an integer/double key/value pair procedure, private :: elpa_set_integer !< private methods to implement the setting of an integer/double key/value pair
procedure, private :: elpa_set_double procedure, private :: elpa_set_double
procedure, private :: elpa_get_integer !< private methods to implement the querry of an integer/double key/value pair
procedure, private :: elpa_get_double
procedure, private :: elpa_solve_d !< private methods to implement the solve step for real/complex procedure, private :: elpa_solve_d !< private methods to implement the solve step for real/complex
!< double/single matrices !< double/single matrices
procedure, private :: elpa_solve_f procedure, private :: elpa_solve_f
...@@ -187,7 +188,7 @@ module elpa_impl ...@@ -187,7 +188,7 @@ module elpa_impl
use elpa1_impl, only : elpa_get_communicators_impl use elpa1_impl, only : elpa_get_communicators_impl
class(elpa_impl_t), intent(inout) :: self class(elpa_impl_t), intent(inout) :: self
integer :: error, error2 integer :: error, error2
integer :: mpi_comm_rows, mpi_comm_cols, mpierr integer :: mpi_comm_parent, mpi_comm_rows, mpi_comm_cols, mpierr, process_row, process_col, timings
#ifdef WITH_MPI #ifdef WITH_MPI
error = ELPA_ERROR error = ELPA_ERROR
...@@ -195,10 +196,13 @@ module elpa_impl ...@@ -195,10 +196,13 @@ module elpa_impl
self%is_set("process_row") == 1 .and. & self%is_set("process_row") == 1 .and. &
self%is_set("process_col") == 1) then self%is_set("process_col") == 1) then
call self%get("mpi_comm_parent", mpi_comm_parent)
call self%get("process_row", process_row)
call self%get("process_col", process_col)
mpierr = elpa_get_communicators_impl(& mpierr = elpa_get_communicators_impl(&
self%get("mpi_comm_parent"), & mpi_comm_parent, &
self%get("process_row"), & process_row, &
self%get("process_col"), & process_col, &
mpi_comm_rows, & mpi_comm_rows, &
mpi_comm_cols) mpi_comm_cols)
...@@ -215,7 +219,8 @@ module elpa_impl ...@@ -215,7 +219,8 @@ module elpa_impl
error = ELPA_OK error = ELPA_OK
#endif #endif
if (self%get("timings") == 1) then call self%get("timings",timings)
if (timings == 1) then
call self%timer%enable() call self%timer%enable()
endif endif
...@@ -280,9 +285,9 @@ module elpa_impl ...@@ -280,9 +285,9 @@ module elpa_impl
!> Parameters !> Parameters
!> \param self class(elpa_impl_t) the allocated ELPA object !> \param self class(elpa_impl_t) the allocated ELPA object
!> \param name string, the key !> \param name string, the key
!> \param value integer, the value of the key/vaue pair
!> \param error integer, optional, to store an error code !> \param error integer, optional, to store an error code
!> \result value integer, the value of the key/vaue pair subroutine elpa_get_integer(self, name, value, error)
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 use elpa_utilities, only : error_unit
...@@ -299,11 +304,11 @@ module elpa_impl ...@@ -299,11 +304,11 @@ module elpa_impl
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // & write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!" " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if end if
end function end subroutine
!c> int elpa_get_integer(elpa_t handle, const char *name, int *error); !c> void elpa_get_integer(elpa_t handle, const char *name, int *value, int *error);
function elpa_get_integer_c(handle, name_p, error) result(value) bind(C, name="elpa_get_integer") subroutine elpa_get_integer_c(handle, name_p, value, error) bind(C, name="elpa_get_integer")
type(c_ptr), intent(in), value :: handle type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p type(c_ptr), intent(in), value :: name_p
...@@ -313,8 +318,8 @@ module elpa_impl ...@@ -313,8 +318,8 @@ module elpa_impl
call c_f_pointer(handle, self) call c_f_pointer(handle, self)
call c_f_pointer(name_p, name) call c_f_pointer(name_p, name)
value = elpa_get_integer(self, name, error) call elpa_get_integer(self, name, value, error)
end function end subroutine
!> \brief function to check whether a key/value pair is set !> \brief function to check whether a key/value pair is set
...@@ -361,7 +366,7 @@ module elpa_impl ...@@ -361,7 +366,7 @@ module elpa_impl
nullify(string) nullify(string)
val = self%get(option_name, actual_error) call self%get(option_name, val, actual_error)
if (actual_error /= ELPA_OK) then if (actual_error /= ELPA_OK) then
if (present(error)) then if (present(error)) then
error = actual_error error = actual_error
...@@ -416,7 +421,7 @@ module elpa_impl ...@@ -416,7 +421,7 @@ module elpa_impl
end subroutine end subroutine
function elpa_get_double(self, name, error) result(value) subroutine elpa_get_double(self, name, value, error)
use iso_c_binding use iso_c_binding
use elpa_generated_fortran_interfaces use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit use elpa_utilities, only : error_unit
...@@ -433,10 +438,10 @@ module elpa_impl ...@@ -433,10 +438,10 @@ module elpa_impl
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // & write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!" " (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if end if
end function end subroutine
!c> int elpa_get_double(elpa_t handle, const char *name, int *error); !c> void elpa_get_double(elpa_t handle, const char *name, double *value, int *error);
function elpa_get_double_c(handle, name_p, error) result(value) bind(C, name="elpa_get_double") subroutine elpa_get_double_c(handle, name_p, value, error) bind(C, name="elpa_get_double")
type(c_ptr), intent(in), value :: handle type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p type(c_ptr), intent(in), value :: name_p
...@@ -446,8 +451,8 @@ module elpa_impl ...@@ -446,8 +451,8 @@ module elpa_impl
call c_f_pointer(handle, self) call c_f_pointer(handle, self)
call c_f_pointer(name_p, name) call c_f_pointer(name_p, name)
value = elpa_get_double(self, name, error) call elpa_get_double(self, name, value, error)