Commit f32ceaf8 by Wenzhe Yu 😎

`Now "thres_pd" can be set and used in single-precision calculations.`
parent 953c28a0
 ... ... @@ -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 ... ...
 ... ... @@ -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_& ... ...
 ... ... @@ -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 ... ...
 ... ... @@ -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 ... ...
 ... ... @@ -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") ... ...
 ... ... @@ -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); ... ...
 ... ... @@ -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!