Commit 2ef1cb32 authored by Marek, Andreas (amarek)'s avatar Marek, Andreas (amarek)

Merge branch 'pkus/devel' into 'master_pre_stage'

Pkus/devel

See merge request !13
parents 9233720a 23db9fa2
......@@ -120,12 +120,6 @@
stop
endif
call e%set("legacy_api", 1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop 1
endif
!! the elpa object needs nev to be set (in case the EVP-solver is
!! called later. Thus it is set by user, do nothing, otherwise,
!! set it to na as default
......@@ -133,6 +127,8 @@
! call e%set("nev", na)
!endif
call e%creating_from_legacy_api()
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
success = .false.
......
......@@ -143,12 +143,8 @@
print *,"Problem setting option. Aborting..."
stop
endif
call e%set("legacy_api", 1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call e%creating_from_legacy_api()
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......@@ -156,6 +152,7 @@
return
endif
if (wantDebug) then
call e%set("debug",1, error)
if (error .ne. ELPA_OK) then
......
......@@ -158,11 +158,7 @@
stop
endif
call e%set("legacy_api", 1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop 1
endif
call e%creating_from_legacy_api()
if (e%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......
......@@ -134,11 +134,8 @@
print *,"Problem setting option. Aborting..."
stop
endif
call obj%set("legacy_api", 1, error)
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
call obj%creating_from_legacy_api()
if (obj%setup() .ne. ELPA_OK) then
print *, "Cannot setup ELPA instance"
......
......@@ -99,6 +99,10 @@ module elpa_api
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
! call before setup if created from the legacy api
! remove this function completely after the legacy api is dropped
procedure(elpa_creating_from_legacy_api_i), deferred, public :: creating_from_legacy_api
! Timer
procedure(elpa_get_time_i), deferred, public :: get_time !< method to get the times from the timer object
procedure(elpa_print_times_i), deferred, public :: print_times !< method to print the timings tree
......@@ -773,6 +777,14 @@ module elpa_api
end interface
#endif
abstract interface
subroutine elpa_creating_from_legacy_api_i(self)
import elpa_t
implicit none
class(elpa_t), intent(inout) :: self
end subroutine
end interface
contains
......
......@@ -73,6 +73,9 @@ module elpa_impl
private
integer :: communicators_owned
!This object has been created through the legacy api.
integer :: from_legacy_api
!> \brief methods available with the elpa_impl_t type
contains
!> \brief the puplic methods
......@@ -86,6 +89,9 @@ module elpa_impl
procedure, public :: can_set => elpa_can_set !< a method to check whether a key/value pair can be set : implemented
!< in elpa_can_set
! call before setup if created from the legacy api
! remove this function completely after the legacy api is dropped
procedure, public :: creating_from_legacy_api => elpa_creating_from_legacy_api
! timer
procedure, public :: get_time => elpa_get_time
......@@ -187,10 +193,13 @@ module elpa_impl
#endif
integer :: error2
allocate(obj, stat=error2)
if (error2 .ne. 0) then
write(error_unit, *) "elpa_allocate(): could not allocate object"
endif
endif
obj%from_legacy_api = 0
! check whether init has ever been called
if ( elpa_initialized() .ne. ELPA_OK) then
......@@ -514,7 +523,7 @@ module elpa_impl
#ifdef WITH_MPI
integer :: mpi_comm_parent, mpi_comm_rows, mpi_comm_cols, np_rows, np_cols, my_id, &
mpierr, mpierr2, process_row, process_col, mpi_string_length, &
present_np_rows, present_np_cols, is_process_id_zero, np_total, legacy_api
present_np_rows, present_np_cols, np_total
character(len=MPI_MAX_ERROR_STRING) :: mpierr_string
character(*), parameter :: MPI_CONSISTENCY_MSG = &
"Provide mpi_comm_parent and EITHER process_row and process_col OR mpi_comm_rows and mpi_comm_cols. Aborting..."
......@@ -546,11 +555,6 @@ module elpa_impl
! inconsistencies and is rather natural from the user point of view
#ifdef WITH_MPI
if (self%is_set("legacy_api") == 1) then
call self%get("legacy_api", legacy_api, error)
if (check_elpa_get(error, ELPA_ERROR_SETUP)) return
endif
if (self%is_set("mpi_comm_parent") == 1) then
call self%get("mpi_comm_parent", mpi_comm_parent, error)
if (check_elpa_get(error, ELPA_ERROR_SETUP)) return
......@@ -562,15 +566,8 @@ module elpa_impl
call mpi_comm_size(mpi_comm_parent, np_total, mpierr)
call self%set("num_processes", np_total, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
is_process_id_zero = 0
if (my_id == 0) &
is_process_id_zero = 1
call self%set("is_process_id_zero", is_process_id_zero, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
else
if (legacy_api .ne. 1) then
if (self%from_legacy_api .ne. 1) then
write(error_unit,*) MPI_CONSISTENCY_MSG
error = ELPA_ERROR
return
......@@ -683,7 +680,7 @@ module elpa_impl
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
endif
if (legacy_api .ne. 1) then
if (self%from_legacy_api .ne. 1) then
if (np_total .ne. np_rows * np_cols) then
print *,"MPI parent communicator and row/col communicators do not match. Aborting..."
stop
......@@ -697,8 +694,6 @@ module elpa_impl
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("process_id", 0, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("is_process_id_zero", 1, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("num_process_rows", 1, error)
if (check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("num_process_cols", 1, error)
......@@ -1744,4 +1739,10 @@ module elpa_impl
return
end function
subroutine elpa_creating_from_legacy_api(self)
implicit none
class(elpa_impl_t), intent(inout) :: self
self%from_legacy_api = 1
end subroutine
end module
......@@ -179,7 +179,6 @@ static const elpa_index_int_entry_t int_entries[] = {
INT_PARAMETER_ENTRY("process_row", "Process row number in the 2D domain decomposition", NULL, PRINT_NO),
INT_PARAMETER_ENTRY("process_col", "Process column number in the 2D domain decomposition", NULL, PRINT_NO),
INT_PARAMETER_ENTRY("process_id", "Process rank", NULL, PRINT_NO),
INT_PARAMETER_ENTRY("is_process_id_zero", "Is it a process with rank zero?", NULL, PRINT_NO),
INT_PARAMETER_ENTRY("num_process_rows", "Number of process row number in the 2D domain decomposition", NULL, PRINT_STRUCTURE),
INT_PARAMETER_ENTRY("num_process_cols", "Number of process column number in the 2D domain decomposition", NULL, PRINT_STRUCTURE),
INT_PARAMETER_ENTRY("num_processes", "Total number of processes", NULL, PRINT_STRUCTURE),
......@@ -188,7 +187,6 @@ static const elpa_index_int_entry_t int_entries[] = {
INT_ANY_ENTRY("mpi_comm_cols", "Communicator for inter-column communication", PRINT_NO),
INT_ANY_ENTRY("mpi_comm_parent", "Parent communicator", PRINT_NO),
INT_ANY_ENTRY("blacs_context", "BLACS context", PRINT_NO),
INT_ANY_ENTRY("legacy_api", "This object has been created through the legacy api. Parameter for internal use only", PRINT_NO),
INT_ENTRY("solver", "Solver to use", ELPA_SOLVER_1STAGE, ELPA_AUTOTUNE_FAST, ELPA_AUTOTUNE_DOMAIN_ANY, \
number_of_solvers, solver_enumerate, solver_is_valid, elpa_solver_name, PRINT_YES),
INT_ENTRY("gpu", "Use GPU acceleration", 0, ELPA_AUTOTUNE_MEDIUM, ELPA_AUTOTUNE_DOMAIN_ANY,
......@@ -290,7 +288,6 @@ FOR_ALL_TYPES(IMPLEMENT_FIND_ENTRY)
#define IMPLEMENT_GETENV(TYPE, PRINTF_SPEC, ...) \
static int getenv_##TYPE(elpa_index_t index, const char *env_variable, enum NOTIFY_FLAGS notify_flag, int n, TYPE *value, const char *error_string) { \
int err; \
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL); \
char *env_value = getenv(env_variable); \
if (env_value) { \
err = elpa_##TYPE##_string_to_value(TYPE##_entries[n].base.name, env_value, value); \
......@@ -301,14 +298,14 @@ FOR_ALL_TYPES(IMPLEMENT_FIND_ENTRY)
const char *value_string = NULL; \
if (elpa_##TYPE##_value_to_string(TYPE##_entries[n].base.name, *value, &value_string) == ELPA_OK) { \
if (!(index->TYPE##_options.notified[n] & notify_flag)) { \
if (is_process_id_zero == 1) { \
if (elpa_index_is_printing_mpi_rank(index)) { \
fprintf(stderr, "ELPA: %s '%s' is set to %s due to environment variable %s\n", \
error_string, TYPE##_entries[n].base.name, value_string, env_variable); \
} \
index->TYPE##_options.notified[n] |= notify_flag; \
} \
} else { \
if (is_process_id_zero == 1) { \
if (elpa_index_is_printing_mpi_rank(index)) { \
fprintf(stderr, "ELPA: %s '%s' is set to '" PRINTF_SPEC "' due to environment variable %s\n", \
error_string, TYPE##_entries[n].base.name, *value, env_variable);\
} \
......@@ -1117,24 +1114,23 @@ int elpa_index_set_autotune_parameters(elpa_index_t index, int autotune_level, i
int current_cpy = current;
char buff[100];
int debug = elpa_index_get_int_value(index, "debug", NULL);
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL);
//if(is_process_id_zero) fprintf(stderr, "***Trying a new autotuning index %d\n", current);
//if(elpa_index_is_printing_mpi_rank(index)) fprintf(stderr, "***Trying a new autotuning index %d\n", current);
for (int i = 0; i < nelements(int_entries); i++) {
if (is_tunable(index, i, autotune_level, autotune_domain)) {
int value = int_entries[i].enumerate(index, current_cpy % int_entries[i].cardinality(index));
//if(is_process_id_zero) fprintf(stderr, " * val[%d] = %d -> %d\n", i, current_cpy % int_entries[i].cardinality(index), value);
//if(elpa_index_is_printing_mpi_rank(index)) fprintf(stderr, " * val[%d] = %d -> %d\n", i, current_cpy % int_entries[i].cardinality(index), value);
/* Try to set option i to that value */
if (int_entries[i].valid(index, i, value)) {
index->int_options.values[i] = value;
} else {
//if(is_process_id_zero) fprintf(stderr, " *NOT VALID becaluse of i %d (%s) and value %d translated to %d\n", i, int_entries[i].base.name, current_cpy % int_entries[i].cardinality(index), value);
//if(elpa_index_is_printing_mpi_rank(index)) fprintf(stderr, " *NOT VALID becaluse of i %d (%s) and value %d translated to %d\n", i, int_entries[i].base.name, current_cpy % int_entries[i].cardinality(index), value);
return 0;
}
current_cpy /= int_entries[i].cardinality(index);
}
}
if (debug == 1 && is_process_id_zero) {
if (debug == 1 && elpa_index_is_printing_mpi_rank(index)) {
fprintf(stderr, "\n*** AUTOTUNING: setting a new combination of parameters, idx %d ***\n", current);
elpa_index_print_autotune_parameters(index, autotune_level, autotune_domain);
fprintf(stderr, "***\n\n");
......@@ -1146,8 +1142,7 @@ int elpa_index_set_autotune_parameters(elpa_index_t index, int autotune_level, i
int elpa_index_print_autotune_parameters(elpa_index_t index, int autotune_level, int autotune_domain) {
char buff[100];
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL);
if (is_process_id_zero) {
if (elpa_index_is_printing_mpi_rank(index)) {
for (int i = 0; i < nelements(int_entries); i++) {
if (is_tunable(index, i, autotune_level, autotune_domain)) {
elpa_index_print_int_parameter(index, buff, i);
......@@ -1179,8 +1174,7 @@ int elpa_index_print_autotune_state(elpa_index_t index, int autotune_level, int
}
}
}
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL);
if (is_process_id_zero) {
if (elpa_index_is_printing_mpi_rank(index)) {
int output_to_file = (strlen(file_name) > 0);
if(output_to_file) {
f = fopen(file_name, "w");
......@@ -1264,7 +1258,7 @@ int elpa_index_load_autotune_state(elpa_index_t index, int* autotune_level, int*
FILE *f;
//TODO: should be broadcasted, instead of read on all ranks
//if(is_process_id_zero){
//if(elpa_index_is_printing_mpi_rank(index)){
f = fopen(file_name, "r");
if (f == NULL) {
......@@ -1301,8 +1295,7 @@ int elpa_index_print_settings(elpa_index_t index, char *file_name) {
sprintf(out_set, "%s", EXPLICIT_PARAMETERS);
sprintf(out_defaults, "%s", DEFAULT_PARAMETERS);
sprintf(out_nowhere, "Not to be printed:\n");
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL);
if(is_process_id_zero){
if(elpa_index_is_printing_mpi_rank(index)){
for (int i = 0; i < nelements(int_entries); i++) {
if(int_entries[i].base.print_flag == PRINT_STRUCTURE) {
out = &out_structure;
......@@ -1342,11 +1335,10 @@ int elpa_index_load_settings(elpa_index_t index, char *file_name) {
char line[LEN], s[LEN];
int n;
FILE *f;
int is_process_id_zero = elpa_index_get_int_value(index, "is_process_id_zero", NULL);
int skip, explicit;
//TODO: should be broadcasted, instead of read on all ranks
//if(is_process_id_zero){
//if(elpa_index_is_printing_mpi_rank(index)){
f = fopen(file_name, "r");
if (f == NULL) {
......@@ -1379,3 +1371,15 @@ int elpa_index_load_settings(elpa_index_t index, char *file_name) {
return 1;
}
int elpa_index_is_printing_mpi_rank(elpa_index_t index)
{
int process_id;
if(elpa_index_int_value_is_set(index, "process_id")){
process_id = elpa_index_get_int_value(index, "process_id", NULL);
return (process_id == 0);
}
printf("Warning: process_id not set, printing on all MPI ranks. This can happen with legacy API.");
return 1;
}
......@@ -498,3 +498,5 @@ int elpa_index_print_autotune_state(elpa_index_t index, int autotune_level, int
*/
int elpa_index_load_autotune_state(elpa_index_t index, int* autotune_level, int* autotune_domain, int* min_loc,
double* min_val, int* current, int* cardinality, char* filename);
int elpa_index_is_printing_mpi_rank(elpa_index_t index);
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