Skip to content
GitLab
Commit f32ceaf8 authored by Wenzhe Yu's avatar Wenzhe Yu 😎
Browse files

Add float to elpa_index 

Now "thres_pd" can be set and used in single-precision calculations.
parent 953c28a0
Hide whitespace changes
Inline Side-by-side
src/elpa1/elpa1_template.F90
View file @ f32ceaf8
......@@ -468,9 +468,13 @@ function elpa_solve_evp_&
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&PRECISION&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&PRECISION&
&. Aborting..."
stop
endif
......
src/elpa2/elpa2_template.F90
View file @ f32ceaf8
......@@ -813,16 +813,19 @@
do_trans_to_band = .false.
do_trans_to_full = .false.
else
call obj%get("check_pd",check_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for check_pd. Aborting..."
stop
endif
if (check_pd .eq. 1) then
call obj%get("thres_pd",thres_pd,error)
call obj%get("thres_pd_&
&PRECISION&
&",thres_pd,error)
if (error .ne. ELPA_OK) then
print *,"Problem getting option for thres_pd. Aborting..."
print *,"Problem getting option for thres_pd_&
&PRECISION&
&. Aborting..."
stop
endif
......@@ -1040,8 +1043,8 @@
call obj%timer%stop("elpa_solve_evp_&
&MATH_DATATYPE&
&_2stage_&
&PRECISION&
&")
&PRECISION&
&")
1 format(a,f10.3)
end function elpa_solve_evp_&
......
src/elpa_abstract_impl.F90
View file @ f32ceaf8
......@@ -79,10 +79,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
......@@ -156,6 +158,71 @@ module elpa_abstract_impl
#endif
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 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
#ifdef USE_FORTRAN2008
integer, optional :: error
#else
integer :: error
#endif
actual_error = elpa_index_set_float_value_c(self%index, name // c_null_char, value)
#ifdef USE_FORTRAN2008
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
#else
error = actual_error
#endif
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 iso_c_binding
use elpa_utilities, only : error_unit
class(elpa_abstract_impl_t) :: self
character(*), intent(in) :: name
real(kind=c_float) :: value
#ifdef USE_FORTRAN2008
integer, intent(out), optional :: error
#else
integer, intent(out) :: error
#endif
integer :: actual_error
value = elpa_index_get_float_value_c(self%index, name // c_null_char, actual_error)
#ifdef USE_FORTRAN2008
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
#else
error = actual_error
#endif
end subroutine
!> \brief internal subroutine to set a double key/value pair
!> Parameters
!> \param self the allocated ELPA object
......
src/elpa_api.F90
View file @ f32ceaf8
......@@ -88,12 +88,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
......@@ -182,9 +184,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
......@@ -379,7 +383,7 @@ module elpa_api
end function
end interface
!> \brief abstract definition of the autotune set_best method
!> Parameters
!> \details
......@@ -402,7 +406,7 @@ module elpa_api
end subroutine
end interface
!> \brief abstract definition of the autotune print best method
!> Parameters
!> \details
......@@ -579,6 +583,54 @@ module elpa_api
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 iso_c_binding
import elpa_t
implicit none
class(elpa_t) :: self
character(*), intent(in) :: name
real(kind=c_float), intent(in) :: value
#ifdef USE_FORTRAN2008
integer, optional :: error
#else
integer :: error
#endif
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 iso_c_binding
import elpa_t
implicit none
class(elpa_t) :: self
character(*), intent(in) :: name
real(kind=c_float) :: value
#ifdef USE_FORTRAN2008
integer, intent(out), optional :: error
#else
integer, intent(out) :: error
#endif
end subroutine
end interface
!> \brief abstract definition of set method for double values
!> Parameters
!> \details
......@@ -775,7 +827,7 @@ 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
......
src/elpa_impl.F90
View file @ f32ceaf8
......@@ -126,13 +126,13 @@ module elpa_impl
procedure, public :: elpa_skew_eigenvalues_f
procedure, public :: elpa_generalized_eigenvectors_d !< public methods to implement the solve step for generalized
procedure, public :: elpa_generalized_eigenvectors_d !< public methods to implement the solve step for generalized
!< eigenproblem and real/complex double/single matrices
procedure, public :: elpa_generalized_eigenvectors_f
procedure, public :: elpa_generalized_eigenvectors_dc
procedure, public :: elpa_generalized_eigenvectors_fc
procedure, public :: elpa_generalized_eigenvalues_d !< public methods to implement the solve step for generalized
procedure, public :: elpa_generalized_eigenvalues_d !< public methods to implement the solve step for generalized
!< eigenproblem and real/complex double/single matrices
procedure, public :: elpa_generalized_eigenvalues_f
procedure, public :: elpa_generalized_eigenvalues_dc
......@@ -439,7 +439,7 @@ module elpa_impl
subroutine elpa_print_settings_c(handle, error) bind(C, name="elpa_print_settings")
type(c_ptr), value :: handle
type(elpa_impl_t), pointer :: self
integer(kind=c_int) :: error
call c_f_pointer(handle, self)
......@@ -875,7 +875,7 @@ module elpa_impl
character(len=elpa_strlen_c(name_p)), pointer :: name
integer(kind=c_int) :: value
integer(kind=c_int), intent(inout) :: error
call c_f_pointer(handle, self)
call c_f_pointer(name_p, name)
call elpa_get_integer(self, name, value, error)
......@@ -916,7 +916,7 @@ module elpa_impl
!> \param self class(elpa_impl_t) the allocated ELPA object
!> \param option_name string: the name of the options, whose value should be converted
!> \param error integer: errpr code
!> \result string string: the humanreadable string
!> \result string string: the humanreadable string
function elpa_value_to_string(self, option_name, error) result(string)
class(elpa_impl_t), intent(in) :: self
character(kind=c_char, len=*), intent(in) :: option_name
......@@ -959,6 +959,54 @@ module elpa_impl
end function
!c> /*! \brief C interface for the implementation of the elpa_set_float method
!c> * This method is available to the user as C generic elpa_set method
!c> *
!c> * \param handle handle of the ELPA object for which a key/value pair should be set
!c> * \param name the name of the key
!c> * \param value the value to be set for the key
!c> * \param error on return the error code, which can be queried with elpa_strerr()
!c> * \result void
!c> */
!c> void elpa_set_float(elpa_t handle, const char *name, float value, int *error);
subroutine elpa_set_float_c(handle, name_p, value, error) bind(C, name="elpa_set_float")
type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p
character(len=elpa_strlen_c(name_p)), pointer :: name
real(kind=c_float), intent(in), value :: value
integer(kind=c_int), intent(in) :: error
call c_f_pointer(handle, self)
call c_f_pointer(name_p, name)
call elpa_set_float(self, name, value, error)
end subroutine
!c> /*! \brief C interface for the implementation of the elpa_get_float 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
!c> * \param name the name of the key
!c> * \param value the value to be obtain for the key
!c> * \param error on return the error code, which can be queried with elpa_strerr()
!c> * \result void
!c> */
!c> void elpa_get_float(elpa_t handle, const char *name, float *value, int *error);
subroutine elpa_get_float_c(handle, name_p, value, error) bind(C, name="elpa_get_float")
type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self
type(c_ptr), intent(in), value :: name_p
character(len=elpa_strlen_c(name_p)), pointer :: name
real(kind=c_float) :: value
integer(kind=c_int), intent(inout) :: error
call c_f_pointer(handle, self)
call c_f_pointer(name_p, name)
call elpa_get_float(self, name, value, error)
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
!c> *
......@@ -1005,7 +1053,7 @@ module elpa_impl
call c_f_pointer(name_p, name)
call elpa_get_double(self, name, value, error)
end subroutine
!> \brief function to associate a pointer with an integer value
!> Parameters
......@@ -1370,7 +1418,7 @@ module elpa_impl
type(c_ptr), intent(in), value :: handle
type(elpa_impl_t), pointer :: self
class(elpa_autotune_t), pointer :: tune_state
type(elpa_autotune_impl_t), pointer :: obj
type(elpa_autotune_impl_t), pointer :: obj
integer(kind=c_int), intent(in), value :: level
integer(kind=c_int), intent(in), value :: domain
type(c_ptr) :: ptr
......@@ -1385,7 +1433,7 @@ module elpa_impl
class default
print *, "This should not happen"
stop
end select
end select
ptr = c_loc(obj)
end function
......@@ -1694,7 +1742,7 @@ module elpa_impl
!c> * \param elpa_t handle: of the ELPA object which should be tuned
!c> * \param elpa_autotune_t autotune_handle: the autotuning object
!c> * \param error int *
!c> * \result none
!c> * \result none
!c> */
!c> void elpa_autotune_print_state(elpa_t handle, elpa_autotune_t autotune_handle, int *error);
subroutine elpa_autotune_print_state_c(handle, autotune_handle, error) bind(C, name="elpa_autotune_print_state")
......@@ -1772,7 +1820,7 @@ module elpa_impl
!c> * \param elpa_t handle: of the ELPA object which should be tuned
!c> * \param elpa_autotune_t autotune_handle: the autotuning object
!c> * \param error int *
!c> * \result none
!c> * \result none
!c> */
!c> void elpa_autotune_save_state(elpa_t handle, elpa_autotune_t autotune_handle, const char *filename, int *error);
subroutine elpa_autotune_save_state_c(handle, autotune_handle, filename_p, error) bind(C, name="elpa_autotune_save_state")
......@@ -1854,7 +1902,7 @@ module elpa_impl
!c> * \param elpa_t handle: of the ELPA object which should be tuned
!c> * \param elpa_autotune_t autotune_handle: the autotuning object
!c> * \param error int *
!c> * \result none
!c> * \result none
!c> */
!c> void elpa_autotune_load_state(elpa_t handle, elpa_autotune_t autotune_handle, const char *filename, int *error);
subroutine elpa_autotune_load_state_c(handle, autotune_handle, filename_p, error) bind(C, name="elpa_autotune_load_state")
......@@ -1880,7 +1928,7 @@ module elpa_impl
!c> * \param elpa_t handle: of the ELPA object which should be tuned
!c> * \param elpa_autotune_t autotune_handle: the autotuning object
!c> * \param error int *
!c> * \result none
!c> * \result none
!c> */
!c> void elpa_autotune_set_best(elpa_t handle, elpa_autotune_t autotune_handle, int *error);
subroutine elpa_autotune_set_best_c(handle, autotune_handle, error) bind(C, name="elpa_autotune_set_best")
......@@ -1903,7 +1951,7 @@ module elpa_impl
!c> * \param elpa_t handle: of the ELPA object which should be tuned
!c> * \param elpa_autotune_t autotune_handle: the autotuning object
!c> * \param error int *
!c> * \result none
!c> * \result none
!c> */
!c> void elpa_autotune_print_best(elpa_t handle, elpa_autotune_t autotune_handle, int *error);
subroutine elpa_autotune_print_best_c(handle, autotune_handle, error) bind(C, name="elpa_autotune_print_best")
......
src/elpa_index.c
View file @ f32ceaf8
......@@ -131,6 +131,9 @@ static int skewsymmetric_is_valid(elpa_index_t index, int n, int new_value);
static int is_positive(elpa_index_t index, int n, int new_value);
static int elpa_float_string_to_value(char *name, char *string, float *value);
static int elpa_float_value_to_string(char *name, float value, const char **string);
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);
......@@ -269,6 +272,21 @@ static const elpa_index_int_entry_t int_entries[] = {
BOOL_ENTRY("cannon_for_generalized", "Whether to use Cannons algorithm for the generalized EVP", 1, ELPA_AUTOTUNE_NOT_TUNABLE, 0, PRINT_YES),
};
#define READONLY_FLOAT_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 0, 1, 0) \
}
#define FLOAT_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_float_entry_t float_entries[] = {
FLOAT_ENTRY("thres_pd_single", "Threshold to define ill-conditioning, default 0.00001", 0.00001, PRINT_YES),
};
#define READONLY_DOUBLE_ENTRY(option_name, option_description) \
{ \
BASE_ENTRY(option_name, option_description, 0, 1, 0) \
......@@ -281,7 +299,7 @@ static const elpa_index_int_entry_t int_entries[] = {
}
static const elpa_index_double_entry_t double_entries[] = {
DOUBLE_ENTRY("thres_pd", "Threshold to define ill-conditioning, default 0.00001", 0.00001, PRINT_YES),
DOUBLE_ENTRY("thres_pd_double", "Threshold to define ill-conditioning, default 0.00001", 0.00001, PRINT_YES),
};
void elpa_index_free(elpa_index_t index) {
......@@ -541,6 +559,23 @@ int elpa_int_string_to_value(char *name, char *string, int *value) {
return ELPA_ERROR_ENTRY_INVALID_VALUE;
}
int elpa_float_string_to_value(char *name, char *string, float *value) {
float val;
int ret = sscanf(string, "%lf", &val);
if (ret == 1) {
*value = val;
return ELPA_OK;
} else {
/* \todo: remove */
fprintf(stderr, "ELPA: DEBUG: Could not parse float value '%s' for option '%s'\n", string, name);
return ELPA_ERROR_ENTRY_INVALID_VALUE;
}
}
int elpa_float_value_to_string(char *name, float value, const char **string) {
return ELPA_ERROR_ENTRY_NO_STRING_REPRESENTATION;
}
int elpa_double_string_to_value(char *name, char *string, double *value) {
double val;
int ret = sscanf(string, "%lf", &val);
......
src/elpa_index.h
View file @ f32ceaf8
......@@ -61,6 +61,7 @@
#define FOR_ALL_TYPES(X) \
X(int, "%d", "%d", -1) \
X(float, "%g", "%lg", NAN) \
X(double, "%g", "%lg", NAN)
/* A simple structure for storing values to a pre-set
......@@ -77,6 +78,7 @@ typedef int (*elpa_index_enumerate_int_option_t)(elpa_index_t index, int i);
/* Function types to check the validity of a value */
typedef int (*elpa_index_valid_int_t)(elpa_index_t index, int n, int new_value);
typedef int (*elpa_index_valid_float_t)(elpa_index_t index, int n, float new_value);
typedef int (*elpa_index_valid_double_t)(elpa_index_t index, int n, double new_value);
/* Function type to give a string representation of a value */
......@@ -106,6 +108,13 @@ typedef struct {
} elpa_index_int_entry_t;
typedef struct {
elpa_index_entry_t base;
float default_value;
elpa_index_valid_float_t valid;
} elpa_index_float_entry_t;
typedef struct {
elpa_index_entry_t base;
double default_value;
......@@ -216,6 +225,66 @@ int elpa_index_int_value_is_set(elpa_index_t index, char *name);
int* elpa_index_get_int_loc(elpa_index_t index, char *name);
/*
!f> interface
!f> function elpa_index_get_float_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_float_value")
!f> import c_ptr, c_int, c_float, c_char
!f> type(c_ptr), value :: index
!f> character(kind=c_char), intent(in) :: name(*)
!f>#ifdef USE_FORTRAN2008
!f> integer(kind=c_int), intent(out), optional :: success
!f>#else
!f> integer(kind=c_int), intent(out) :: success
!f>#endif
!f> real(kind=c_float) :: value
!f> end function
!f> end interface
*/
float elpa_index_get_float_value(elpa_index_t index, char *name, int *success);
/*
!f> interface
!f> function elpa_index_set_float_value_c(index, name, value) result(success) &
!f> bind(C, name="elpa_index_set_float_value")
!f> import c_ptr, c_int, c_float, c_char
!f> type(c_ptr), value :: index
!f> character(kind=c_char), intent(in) :: name(*)
!f> real(kind=c_float),intent(in), value :: value
!f> integer(kind=c_int) :: success
!f> end function
!f> end interface
*/
int elpa_index_set_float_value(elpa_index_t index, char *name, float value);
/*
!f> interface
!f> function elpa_index_float_value_is_set_c(index, name) result(success) &
!f> bind(C, name="elpa_index_float_value_is_set")
!f> import c_ptr, c_int, c_char
!f> type(c_ptr), value :: index
!f> character(kind=c_char), intent(in) :: name(*)
!f> integer(kind=c_int) :: success
!f> end function
!f> end interface
*/
int elpa_index_float_value_is_set(elpa_index_t index, char *name);
/*
!f> interface
!f> function elpa_index_get_float_loc_c(index, name) result(loc) bind(C, name="elpa_index_get_float_loc")
!f> import c_ptr, c_char
!f> type(c_ptr), value :: index
!f> character(kind=c_char), intent(in) :: name(*)
!f> type(c_ptr) :: loc
!f> end function
!f> end interface
*/
float* elpa_index_get_float_loc(elpa_index_t index, char *name);
/*
!f> interface
!f> function elpa_index_get_double_value_c(index, name, success) result(value) bind(C, name="elpa_index_get_double_value")
......
Supports Markdown
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