Commit f8c2784e authored by Lorenz Huedepohl's avatar Lorenz Huedepohl

Support private index entries

These can be used internally by

  call self%set_private(name, value)

   or

  call self%get_private(name, value)

but are not valid for the self%set()/get() routines, i.e. are not
visible to users of ELPA.
parent 0bbb7437
......@@ -90,7 +90,7 @@ subroutine elpa_reduce_add_vectors_&
integer(kind=ik) :: myps, mypt, nps, npt
integer(kind=ik) :: n, lc, k, i, ips, ipt, ns, nl, mpierr
integer(kind=ik) :: lcm_s_t, nblks_tot
integer(kind=ik) :: auxstride, tylerk, error_unit
integer(kind=ik) :: auxstride, tylerk
call obj%timer%start("elpa_reduce_add_vectors_&
&MATH_DATATYPE&
......
......@@ -49,11 +49,16 @@
!> \brief Fortran module to provide an abstract definition of the implementation. Do not use directly. Use the module "elpa"
module elpa_abstract_impl
use elpa_api
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
#ifdef HAVE_DETAILED_TIMINGS
use ftimings
#else
use timings_dummy
#endif
implicit none
! The reason to have this additional layer is to allow for members (here the
......@@ -70,6 +75,251 @@ module elpa_abstract_impl
#else
type(timer_dummy_t) :: timer
#endif
type(c_ptr) :: index = C_NULL_PTR
contains
! set private fields in the index
generic, public :: set_private => &
elpa_set_private_integer, &
elpa_set_private_double
generic, public :: get_private => &
elpa_get_private_integer, &
elpa_get_private_double
procedure, private :: elpa_set_private_integer
procedure, private :: elpa_set_private_double
procedure, private :: elpa_get_private_integer
procedure, private :: elpa_get_private_double
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
end type
contains
!> \brief internal subroutine to set an integer key/value pair
!> Parameters
!> \param self the allocated ELPA object
!> \param name string, the key
!> \param value integer, the value to be set
!> \result error integer, the error code
subroutine elpa_set_private_integer(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int), intent(in) :: value
integer, optional :: error
integer :: actual_error
actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,i0,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!> \brief internal subroutine to get an integer key/value pair
!> Parameters
!> \param self 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
subroutine elpa_get_private_integer(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int) :: value
integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_int_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!> \brief internal subroutine to set a double key/value pair
!> Parameters
!> \param self the allocated ELPA object
!> \param name string, the key
!> \param value double, the value to be set
!> \result error integer, the error code
subroutine elpa_set_private_double(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double), intent(in) :: value
integer, optional :: error
integer :: actual_error
actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,es12.5,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!> \brief internal subroutine to get an double key/value pair
!> Parameters
!> \param self the allocated ELPA object
!> \param name string, the key
!> \param value double, the value of the key/vaue pair
!> \param error integer, optional, to store an error code
subroutine elpa_get_private_double(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double) :: value
integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_double_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
subroutine elpa_set_integer(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int), intent(in) :: value
integer, optional :: error
integer :: actual_error
integer :: is_private
is_private = elpa_index_int_is_private_c(name // C_NULL_CHAR)
if (is_private == 0) then
call self%set_private(name, value, error)
else
if (is_private == 1) then
actual_error = ELPA_ERROR_ENTRY_NOT_FOUND
else
actual_error = is_private
endif
if (present(error)) then
error = actual_error
else
write(error_unit,'(a)') "ELPA: Error setting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
endif
endif
end subroutine
subroutine elpa_set_double(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double), intent(in) :: value
integer, optional :: error
integer :: actual_error
integer :: is_private
is_private = elpa_index_double_is_private_c(name // C_NULL_CHAR)
if (is_private == 0) then
call self%set_private(name, value, error)
else
if (is_private == 1) then
actual_error = ELPA_ERROR_ENTRY_NOT_FOUND
else
actual_error = is_private
endif
if (present(error)) then
error = actual_error
else
write(error_unit,'(a)') "ELPA: Error setting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
endif
endif
end subroutine
subroutine elpa_get_integer(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int) :: value
integer, intent(out), optional :: error
integer :: actual_error
integer :: is_private
is_private = elpa_index_int_is_private_c(name // C_NULL_CHAR)
if (is_private == 0) then
call self%get_private(name, value, error)
else
if (is_private == 1) then
actual_error = ELPA_ERROR_ENTRY_NOT_FOUND
else
actual_error = is_private
endif
if (present(error)) then
error = actual_error
else
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
endif
endif
end subroutine
subroutine elpa_get_double(self, name, value, error)
use iso_c_binding
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double) :: value
integer, intent(out), optional :: error
integer :: actual_error
integer :: is_private
is_private = elpa_index_double_is_private_c(name // C_NULL_CHAR)
if (is_private == 0) then
call self%get_private(name, value, error)
else
if (is_private == 1) then
actual_error = ELPA_ERROR_ENTRY_NOT_FOUND
else
actual_error = is_private
endif
if (present(error)) then
error = actual_error
else
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
endif
endif
end subroutine
end module
......@@ -59,7 +59,6 @@ module elpa_impl
!> \brief Definition of the extended elpa_impl_t type
type, extends(elpa_abstract_impl_t) :: elpa_impl_t
private
type(c_ptr) :: index = C_NULL_PTR
!> \brief methods available with the elpa_impl_t type
contains
......@@ -82,13 +81,7 @@ module elpa_impl
!> \brief the private methods
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_eigenvectors_d !< private methods to implement the solve step for real/complex
procedure, private :: elpa_eigenvectors_d !< private methods to implement the solve step for real/complex
!< double/single matrices
procedure, private :: elpa_eigenvectors_f
procedure, private :: elpa_eigenvectors_dc
......@@ -254,33 +247,6 @@ module elpa_impl
end function
!> \brief subroutine to set an integer key/value pair
!> Parameters
!> \param self class(elpa_impl_t) the allocated ELPA object
!> \param name string, the key
!> \param value integer, the value to be set
!> \result error integer, the error code
subroutine elpa_set_integer(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int), intent(in) :: value
integer, optional :: error
integer :: actual_error
actual_error = elpa_index_set_int_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,i0,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!c> /*! \brief C interface for the implementation of the elpa_set_integer method
!c> * This method is available to the user as C generic elpa_set method
!c> *
......@@ -305,31 +271,6 @@ module elpa_impl
end subroutine
!> \brief function to get an integer key/value pair
!> 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
subroutine elpa_get_integer(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self
character(*), intent(in) :: name
integer(kind=c_int) :: value
integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_int_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!c> /*! \brief C interface for the implementation of the elpa_get_integer method
!c> * This method is available to the user as C generic elpa_get method
!c> *
......@@ -416,31 +357,6 @@ module elpa_impl
endif
end function
!> \brief subroutine to set a double key/value pair
!> Parameters
!> \param self class(elpa_impl_t) the allocated ELPA object
!> \param name string, the key
!> \param value double, the value to be set
!> \result error integer, the error code
subroutine elpa_set_double(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double), intent(in) :: value
integer, optional :: error
integer :: actual_error
actual_error = elpa_index_set_double_value_c(self%index, name // c_null_char, value, 0)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a,es12.5,a)') "ELPA: Error setting option '" // name // "' to value ", value, &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!c> /*! \brief C interface for the implementation of the elpa_set_double method
!c> * This method is available to the user as C generic elpa_set method
......@@ -465,33 +381,8 @@ module elpa_impl
call elpa_set_double(self, name, value, error)
end subroutine
!> \brief function to get an double key/value pair
!> Parameters
!> \param self class(elpa_impl_t) the allocated ELPA object
!> \param name string, the key
!> \param value double, the value of the key/vaue pair
!> \param error integer, optional, to store an error code
subroutine elpa_get_double(self, name, value, error)
use iso_c_binding
use elpa_generated_fortran_interfaces
use elpa_utilities, only : error_unit
class(elpa_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_double) :: value
integer, intent(out), optional :: error
integer :: actual_error
value = elpa_index_get_double_value_c(self%index, name // c_null_char, actual_error)
if (present(error)) then
error = actual_error
else if (actual_error /= ELPA_OK) then
write(error_unit,'(a)') "ELPA: Error getting option '" // name // "'" // &
" (got: " // elpa_strerr(actual_error) // ") and you did not check for errors!"
end if
end subroutine
!c> /*! \brief C interface for the implementation of the elpa_get_double method
!c> /*! \brief C interface for the implementation of the elpa_get_double method
!c> * This method is available to the user as C generic elpa_get method
!c> *
!c> * \param handle handle of the ELPA object for which a key/value pair should be queried
......
......@@ -73,7 +73,7 @@ static int bw_is_valid(elpa_index_t index, int n, int new_value);
static int elpa_double_string_to_value(char *name, char *string, double *value);
static int elpa_double_value_to_string(char *name, double value, const char **string);
#define BASE_ENTRY(option_name, option_description, once_value, readonly_value) \
#define BASE_ENTRY(option_name, option_description, once_value, readonly_value, private_value) \
.base = { \
.name = option_name, \
.description = option_description, \
......@@ -81,16 +81,17 @@ static int elpa_double_value_to_string(char *name, double value, const char **st
.readonly = readonly_value, \
.env_default = "ELPA_DEFAULT_" option_name, \
.env_force = "ELPA_FORCE_" option_name, \
.private = private_value, \
}
#define INT_PARAMETER_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 1, 0), \
BASE_ENTRY(option_name, option_description, 1, 0, 0), \
}
#define BOOL_ENTRY(option_name, option_description, default) \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
BASE_ENTRY(option_name, option_description, 0, 0, 0), \
.default_value = default, \
.cardinality = cardinality_bool, \
.enumerate = enumerate_identity, \
......@@ -99,7 +100,7 @@ static int elpa_double_value_to_string(char *name, double value, const char **st
#define INT_ENTRY(option_name, option_description, default, card_func, enumerate_func, valid_func, to_string_func) \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
BASE_ENTRY(option_name, option_description, 0, 0, 0), \
.default_value = default, \
.cardinality = card_func, \
.enumerate = enumerate_func, \
......@@ -109,7 +110,12 @@ static int elpa_double_value_to_string(char *name, double value, const char **st
#define INT_ANY_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 0, 0), \
BASE_ENTRY(option_name, option_description, 0, 0, 0), \
}
#define PRIVATE_INT_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 0, 0, 1), \
}
static const elpa_index_int_entry_t int_entries[] = {
......@@ -144,7 +150,7 @@ static const elpa_index_int_entry_t int_entries[] = {
#define READONLY_DOUBLE_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 0, 1) \
BASE_ENTRY(option_name, option_description, 0, 1, 0) \
}
static const elpa_index_double_entry_t double_entries[] = {
......@@ -322,7 +328,36 @@ int elpa_index_value_is_set(elpa_index_t index, char *name) {
FOR_ALL_TYPES(RET_IF_SET)
printf("ERROR: Could not find entry '%s'\n", name);
fprintf(stderr, "ELPA Error: Could not find entry '%s'\n", name);
return res;
}
#define IMPLEMENT_IS_PRIVATE_FUNCTION(TYPE, ...) \
int elpa_index_##TYPE##_is_private(char *name) { \
if (sizeof(TYPE##_entries) == 0) { \
return ELPA_ERROR_ENTRY_NOT_FOUND; \
} \
int n = find_##TYPE##_entry(name); \
if (n >= 0) { \
return TYPE##_entries[n].base.private; \
} else { \
return ELPA_ERROR_ENTRY_NOT_FOUND; \
} \
}
FOR_ALL_TYPES(IMPLEMENT_IS_PRIVATE_FUNCTION)
int elpa_index_is_private(char *name) {
int res = ELPA_ERROR;
#define RET_IF_PRIVATE(TYPE, ...) \
res = elpa_index_##TYPE##_is_private(name); \
if (res >= 0) { \
return res; \
}
FOR_ALL_TYPES(RET_IF_PRIVATE);
fprintf(stderr, "ELPA Error: Could not find entry '%s'\n", name);
return res;
}
......
......@@ -89,6 +89,7 @@ typedef struct {
char *env_force;
int once;
int readonly;
int private;
} elpa_index_entry_t;
......@@ -190,6 +191,30 @@ int elpa_index_set_int_value(elpa_index_t index, char *name, int value, int forc
int elpa_index_int_value_is_set(elpa_index_t index, char *name);
/*
!f> interface
!f> function elpa_index_int_is_private_c(name) result(success) bind(C, name="elpa_index_int_is_private")
!f> import c_int, c_char
!f> character(kind=c_char), intent(in) :: name(*)
!f> integer(kind=c_int) :: success
!f> end function
!f> end interface
*/
int elpa_index_int_is_private(char *name);
/*
!f> interface
!f> function elpa_index_double_is_private_c(name) result(success) bind(C, name="elpa_index_double_is_private")
!f> import c_int, c_char
!f> character(kind=c_char), intent(in) :: name(*)
!f> integer(kind=c_int) :: success
!f> end function
!f> end interface
*/
int elpa_index_double_is_private(char *name);
/*
!f> interface
!f> function elpa_index_get_int_loc_c(index, name) result(loc) bind(C, name="elpa_index_get_int_loc")
......
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