Skip to content

GitLab

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

Convert get method from function to subroutine

parent 6a4cc5fb
Hide whitespace changes
Inline Side-by-side
elpa/elpa_generic.h
View file @ 681ab7bc
......@@ -11,6 +11,18 @@
elpa_set_double \
)(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()
*/
......
src/elpa1/elpa1_template.X90
View file @ 681ab7bc
......@@ -104,7 +104,7 @@ function elpa_solve_evp_&
integer(kind=c_int) :: my_pe, n_pes, my_prow, my_pcol, mpierr
real(kind=C_DATATYPE_KIND), allocatable :: e(:)
logical :: wantDebug
integer(kind=c_int) :: istat
integer(kind=c_int) :: istat, debug, gpu
character(200) :: errorMessage
integer(kind=ik) :: na, nev, lda, ldq, nblk, matrixCols, &
mpi_comm_rows, mpi_comm_cols, mpi_comm_all
......@@ -122,11 +122,12 @@ function elpa_solve_evp_&
nblk = obj%nblk
matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
mpi_comm_all = obj%get("mpi_comm_parent")
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
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.
else
useGPU = .false.
......@@ -148,7 +149,8 @@ function elpa_solve_evp_&
call obj%timer%stop("mpi_communication")
success = .true.
wantDebug = obj%get("debug") == 1
call obj%get("debug", debug)
wantDebug = debug == 1
do_useGPU = .false.
......@@ -169,7 +171,8 @@ function elpa_solve_evp_&
endif
else
! 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 (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then
......
src/elpa1/elpa_cholesky_template.X90
View file @ 681ab7bc
......@@ -94,10 +94,11 @@
nblk = obj%nblk
matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
call obj%get("mpi_comm_rows",mpi_comm_rows )
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.
else
wantDebug = .false.
......
src/elpa1/elpa_invert_trm.X90
View file @ 681ab7bc
......@@ -88,7 +88,7 @@
#endif
logical :: wantDebug
logical :: success
integer(kind=ik) :: istat
integer(kind=ik) :: istat, debug
character(200) :: errorMessage
call obj%timer%start("elpa_invert_trm_&
......@@ -102,10 +102,11 @@
nblk = obj%nblk
matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
call obj%get("mpi_comm_rows",mpi_comm_rows)
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.
else
wantDebug = .true.
......
src/elpa1/elpa_multiply_a_b.X90
View file @ 681ab7bc
......@@ -108,8 +108,8 @@
nblk = obj%nblk
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
success = .true.
call obj%timer%start("mpi_communication")
......
src/elpa1/elpa_solve_tridi_impl_public.X90
View file @ 681ab7bc
......@@ -77,6 +77,8 @@
logical :: wantDebug
logical :: success
integer :: debug
call obj%timer%start("elpa_solve_tridi_public_&
&MATH_DATATYPE&
&_&
......@@ -88,10 +90,11 @@
ldq = obj%local_nrows
matrixCols = obj%local_ncols
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
call obj%get("mpi_comm_rows", mpi_comm_rows)
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.
else
wantDebug = .false.
......
src/elpa2/elpa2_template.X90
View file @ 681ab7bc
......@@ -97,7 +97,7 @@
integer(kind=c_int) :: i
logical :: success, successCUDA
logical :: wantDebug
integer(kind=c_int) :: istat
integer(kind=c_int) :: istat, gpu, debug, qr
character(200) :: errorMessage
logical :: do_useGPU, do_useGPU_trans_ev_tridi
integer(kind=c_int) :: numberOfGPUDevices
......@@ -122,40 +122,44 @@
matrixCols = obj%local_ncols
#if REALCASE == 1
kernel = obj%get("real_kernel")
call obj%get("real_kernel",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
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
endif
endif
#endif
#if COMPLEXCASE == 1
kernel = obj%get("complex_kernel")
call obj%get("complex_kernel",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
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
endif
endif
#endif
mpi_comm_rows = obj%get("mpi_comm_rows")
mpi_comm_cols = obj%get("mpi_comm_cols")
mpi_comm_all = obj%get("mpi_comm_parent")
call obj%get("mpi_comm_rows",mpi_comm_rows)
call obj%get("mpi_comm_cols",mpi_comm_cols)
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.
else
useGPU = .false.
endif
#if REALCASE == 1
if (obj%get("qr") .eq. 1) then
call obj%get("qr",qr)
if (qr .eq. 1) then
useQR = .true.
else
useQR = .false.
......@@ -172,7 +176,8 @@
call mpi_comm_size(mpi_comm_cols,np_cols,mpierr)
call obj%timer%stop("mpi_communication")
wantDebug = obj%get("debug") == 1
call obj%get("debug",debug)
wantDebug = debug == 1
success = .true.
do_useGPU = .false.
......@@ -215,7 +220,8 @@
endif
else
! 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 (check_for_gpu(my_pe,numberOfGPUDevices, wantDebug=wantDebug)) then
......@@ -246,7 +252,7 @@
call obj%timer%start("bandred")
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 (wantDebug) then
write(error_unit,*) "Specified bandwidth has to be a multiple of blocksize: ",nbw
......
src/elpa_api.F90
View file @ 681ab7bc
......@@ -86,8 +86,10 @@ module elpa_api
generic, public :: set => & !< export a method to set integer/double key/values
elpa_set_integer, &
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_can_set_i), deferred, public :: can_set !< method to check whether key/value can be set
......@@ -131,6 +133,9 @@ module elpa_api
procedure(elpa_set_integer_i), deferred, private :: elpa_set_integer
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_f_i), deferred, private :: elpa_solve_f
procedure(elpa_solve_dc_i), deferred, private :: elpa_solve_dc
......@@ -208,10 +213,10 @@ module elpa_api
!> \details
!> \param self class(elpa_t): the ELPA object
!> \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()
!> \result value integer : the value corresponding to the key
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
import elpa_t
implicit none
......@@ -219,7 +224,7 @@ module elpa_api
character(*), intent(in) :: name
integer(kind=c_int) :: value
integer, intent(out), optional :: error
end function
end subroutine
end interface
!> \brief abstract definition of is_set method for integer values
......@@ -282,10 +287,10 @@ module elpa_api
!> \details
!> \param self class(elpa_t): the ELPA object
!> \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
!> \result value double: the value associated with the key
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
import elpa_t
implicit none
......@@ -293,7 +298,7 @@ module elpa_api
character(*), intent(in) :: name
real(kind=c_double) :: value
integer, intent(out), optional :: error
end function
end subroutine
end interface
!> \brief abstract definition of associate method for integer pointers
......
src/elpa_impl.F90
View file @ 681ab7bc
......@@ -69,8 +69,6 @@ module elpa_impl
procedure, public :: destroy => elpa_destroy !< a destroy method: implemented in elpa_destroy
! 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
!< in elpa_is_set
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
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_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
!< double/single matrices
procedure, private :: elpa_solve_f
......@@ -187,7 +188,7 @@ module elpa_impl
use elpa1_impl, only : elpa_get_communicators_impl
class(elpa_impl_t), intent(inout) :: self
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
error = ELPA_ERROR
......@@ -195,10 +196,13 @@ module elpa_impl
self%is_set("process_row") == 1 .and. &
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(&
self%get("mpi_comm_parent"), &
self%get("process_row"), &
self%get("process_col"), &
mpi_comm_parent, &
process_row, &
process_col, &
mpi_comm_rows, &
mpi_comm_cols)
......@@ -215,7 +219,8 @@ module elpa_impl
error = ELPA_OK
#endif
if (self%get("timings") == 1) then
call self%get("timings",timings)
if (timings == 1) then
call self%timer%enable()
endif
......@@ -280,9 +285,9 @@ module elpa_impl
!> Parameters
!> \param self class(elpa_impl_t) the allocated ELPA object
!> \param name string, the key
!> \param value integer, the value of the key/vaue pair
!> \param error integer, optional, to store an error code
!> \result value integer, the value of the key/vaue pair
function elpa_get_integer(self, name, error) result(value)
subroutine elpa_get_integer(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
......@@ -299,11 +304,11 @@ module elpa_impl
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 subroutine
!c> int elpa_get_integer(elpa_t handle, const char *name, int *error);
function elpa_get_integer_c(handle, name_p, error) result(value) bind(C, name="elpa_get_integer")
!c> void elpa_get_integer(elpa_t handle, const char *name, int *value, int *error);
subroutine elpa_get_integer_c(handle, name_p, value, error) bind(C, name="elpa_get_integer")
type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p
......@@ -313,8 +318,8 @@ module elpa_impl
call c_f_pointer(handle, self)
call c_f_pointer(name_p, name)
value = elpa_get_integer(self, name, error)
end function
call elpa_get_integer(self, name, value, error)
end subroutine
!> \brief function to check whether a key/value pair is set
......@@ -361,7 +366,7 @@ module elpa_impl
nullify(string)
val = self%get(option_name, actual_error)
call self%get(option_name, val, actual_error)
if (actual_error /= ELPA_OK) then
if (present(error)) then
error = actual_error
......@@ -416,7 +421,7 @@ module elpa_impl
end subroutine
function elpa_get_double(self, name, error) result(value)
subroutine elpa_get_double(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
......@@ -433,10 +438,10 @@ module elpa_impl
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 subroutine
!c> int elpa_get_double(elpa_t handle, const char *name, int *error);
function elpa_get_double_c(handle, name_p, error) result(value) bind(C, name="elpa_get_double")
!c> void elpa_get_double(elpa_t handle, const char *name, double *value, int *error);
subroutine elpa_get_double_c(handle, name_p, value, error) bind(C, name="elpa_get_double")
type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p
......@@ -446,8 +451,8 @@ module elpa_impl
call c_f_pointer(handle, self)
call c_f_pointer(name_p, name)
value = elpa_get_double(self, name, error)
end function
call elpa_get_double(self, name, value, error)
end subroutine
function elpa_associate_int(self, name) result(value)
......@@ -523,14 +528,15 @@ module elpa_impl
real(kind=c_double) :: ev(self%na)
integer, optional :: error
integer(kind=c_int) :: error_actual
integer(kind=c_int) :: error_actual, solver
logical :: success_l
if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
call self%get("solver", solver)
if (solver .eq. ELPA_SOLVER_1STAGE) then
success_l = elpa_solve_evp_real_1stage_double_impl(self, a, ev, q)
else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
else if (solver .eq. ELPA_SOLVER_2STAGE) then
success_l = elpa_solve_evp_real_2stage_double_impl(self, a, ev, q)
else
print *,"unknown solver"
......@@ -604,15 +610,16 @@ module elpa_impl
real(kind=c_float) :: ev(self%na)
integer, optional :: error
integer(kind=c_int) :: error_actual
integer(kind=c_int) :: error_actual, solver
logical :: success_l
#ifdef WANT_SINGLE_PRECISION_REAL
if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
call self%get("solver",solver)
if (solver .eq. ELPA_SOLVER_1STAGE) then
success_l = elpa_solve_evp_real_1stage_single_impl(self, a, ev, q)
else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
else if (solver .eq. ELPA_SOLVER_2STAGE) then
success_l = elpa_solve_evp_real_2stage_single_impl(self, a, ev, q)
else
print *,"unknown solver"
......@@ -692,13 +699,14 @@ module elpa_impl
real(kind=c_double) :: ev(self%na)
integer, optional :: error
integer(kind=c_int) :: error_actual
integer(kind=c_int) :: error_actual, solver
logical :: success_l
if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
call self%get("solver", solver)
if (solver .eq. ELPA_SOLVER_1STAGE) then
success_l = elpa_solve_evp_complex_1stage_double_impl(self, a, ev, q)
else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
else if (solver .eq. ELPA_SOLVER_2STAGE) then
success_l = elpa_solve_evp_complex_2stage_double_impl(self, a, ev, q)
else
print *,"unknown solver"
......@@ -775,15 +783,16 @@ module elpa_impl
real(kind=c_float) :: ev(self%na)
integer, optional :: error
integer(kind=c_int) :: error_actual
integer(kind=c_int) :: error_actual, solver
logical :: success_l
#ifdef WANT_SINGLE_PRECISION_COMPLEX
if (self%get("solver") .eq. ELPA_SOLVER_1STAGE) then
call self%get("solver", solver)
if (solver .eq. ELPA_SOLVER_1STAGE) then
success_l = elpa_solve_evp_complex_1stage_single_impl(self, a, ev, q)
else if (self%get("solver") .eq. ELPA_SOLVER_2STAGE) then
else if (solver .eq. ELPA_SOLVER_2STAGE) then
success_l = elpa_solve_evp_complex_2stage_single_impl(self, a, ev, q)
else
print *,"unknown solver"
......
test/C/test.c
View file @ 681ab7bc
......@@ -217,7 +217,7 @@ int main(int argc, char** argv) {
assert_elpa_ok(error);
#endif
value = elpa_get_integer(handle, "solver", &error);
elpa_get(handle, "solver", &value, &error);
printf("Solver is set to %d \n", value);
/* Solve EV problem */
......
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