Scheduled maintenance on Monday 2019-06-24 between 10:00-11:00 CEST

Commit 806faa83 authored by Pavel Kus's avatar Pavel Kus

removing stops and properly checking in elpa_impl

the error handling has to be thought of properly in some of the uses
of check_elpa_get/set (e.g. those outside the elpa_setup function)
parent f3144dd9
...@@ -278,6 +278,7 @@ module elpa_impl ...@@ -278,6 +278,7 @@ module elpa_impl
#ifdef HAVE_DETAILED_TIMINGS #ifdef HAVE_DETAILED_TIMINGS
call self%get("timings",timings, error) call self%get("timings",timings, error)
if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
if (timings == 1) then if (timings == 1) then
call self%timer%enable() call self%timer%enable()
endif endif
...@@ -296,25 +297,26 @@ module elpa_impl ...@@ -296,25 +297,26 @@ module elpa_impl
#ifdef WITH_MPI #ifdef WITH_MPI
if(self%is_set("legacy_api") == 1) then if(self%is_set("legacy_api") == 1) then
call self%get("legacy_api", legacy_api, error) call self%get("legacy_api", legacy_api, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
endif endif
if (self%is_set("mpi_comm_parent") == 1) then if (self%is_set("mpi_comm_parent") == 1) then
call self%get("mpi_comm_parent", mpi_comm_parent, error) call self%get("mpi_comm_parent", mpi_comm_parent, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
call mpi_comm_rank(mpi_comm_parent, my_id, mpierr) call mpi_comm_rank(mpi_comm_parent, my_id, mpierr)
call self%set("process_id", my_id, error) call self%set("process_id", my_id, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call mpi_comm_size(mpi_comm_parent, np_total, mpierr) call mpi_comm_size(mpi_comm_parent, np_total, mpierr)
call self%set("num_processes", np_total, error) call self%set("num_processes", np_total, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
is_process_id_zero = 0 is_process_id_zero = 0
if(my_id == 0) & if(my_id == 0) &
is_process_id_zero = 1 is_process_id_zero = 1
call self%set("is_process_id_zero", is_process_id_zero, error) call self%set("is_process_id_zero", is_process_id_zero, error)
if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
else else
if(legacy_api .ne. 1) then if(legacy_api .ne. 1) then
...@@ -334,10 +336,10 @@ module elpa_impl ...@@ -334,10 +336,10 @@ module elpa_impl
endif endif
call self%get("process_row", process_row, error) call self%get("process_row", process_row, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
call self%get("process_col", process_col, error) call self%get("process_col", process_col, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
! mpi_comm_rows is used for communicating WITHIN rows, i.e. all processes ! mpi_comm_rows is used for communicating WITHIN rows, i.e. all processes
! having the same column coordinate share one mpi_comm_rows. ! having the same column coordinate share one mpi_comm_rows.
...@@ -359,10 +361,10 @@ module elpa_impl ...@@ -359,10 +361,10 @@ module elpa_impl
endif endif
call self%set("mpi_comm_rows", mpi_comm_rows,error) call self%set("mpi_comm_rows", mpi_comm_rows,error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("mpi_comm_cols", mpi_comm_cols,error) call self%set("mpi_comm_cols", mpi_comm_cols,error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
! remember that we created those communicators and we need to free them later ! remember that we created those communicators and we need to free them later
self%communicators_owned = 1 self%communicators_owned = 1
...@@ -377,18 +379,18 @@ module elpa_impl ...@@ -377,18 +379,18 @@ module elpa_impl
endif endif
call self%get("mpi_comm_rows", mpi_comm_rows,error) call self%get("mpi_comm_rows", mpi_comm_rows,error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
call self%get("mpi_comm_cols", mpi_comm_cols,error) call self%get("mpi_comm_cols", mpi_comm_cols,error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
call mpi_comm_rank(mpi_comm_rows, process_row, mpierr) call mpi_comm_rank(mpi_comm_rows, process_row, mpierr)
call self%set("process_row", process_row, error) call self%set("process_row", process_row, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call mpi_comm_rank(mpi_comm_cols, process_col, mpierr) call mpi_comm_rank(mpi_comm_cols, process_col, mpierr)
call self%set("process_col", process_col, error) call self%set("process_col", process_col, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
! remember that we DID NOT created those communicators and we WILL NOT free them later ! remember that we DID NOT created those communicators and we WILL NOT free them later
self%communicators_owned = 0 self%communicators_owned = 0
...@@ -405,7 +407,7 @@ module elpa_impl ...@@ -405,7 +407,7 @@ module elpa_impl
call mpi_comm_size(mpi_comm_rows, np_rows, mpierr) call mpi_comm_size(mpi_comm_rows, np_rows, mpierr)
if(self%is_set("num_process_rows") == 1) then if(self%is_set("num_process_rows") == 1) then
call self%get("num_process_rows", present_np_rows, error) call self%get("num_process_rows", present_np_rows, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
if(np_rows .ne. present_np_rows) then if(np_rows .ne. present_np_rows) then
print *,"MPI row communicator not set correctly. Aborting..." print *,"MPI row communicator not set correctly. Aborting..."
...@@ -413,13 +415,13 @@ module elpa_impl ...@@ -413,13 +415,13 @@ module elpa_impl
endif endif
else else
call self%set("num_process_rows", np_rows, error) call self%set("num_process_rows", np_rows, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
endif endif
call mpi_comm_size(mpi_comm_cols, np_cols, mpierr) call mpi_comm_size(mpi_comm_cols, np_cols, mpierr)
if(self%is_set("num_process_cols") == 1) then if(self%is_set("num_process_cols") == 1) then
call self%get("num_process_cols", present_np_cols, error) call self%get("num_process_cols", present_np_cols, error)
call check_elpa_get(error) if(check_elpa_get(error, ELPA_ERROR_SETUP)) return
if(np_cols .ne. present_np_cols) then if(np_cols .ne. present_np_cols) then
print *,"MPI column communicator not set correctly. Aborting..." print *,"MPI column communicator not set correctly. Aborting..."
...@@ -427,7 +429,7 @@ module elpa_impl ...@@ -427,7 +429,7 @@ module elpa_impl
endif endif
else else
call self%set("num_process_cols", np_cols, error) call self%set("num_process_cols", np_cols, error)
call check_elpa_set(error) if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
endif endif
if(legacy_api .ne. 1) then if(legacy_api .ne. 1) then
...@@ -439,12 +441,19 @@ module elpa_impl ...@@ -439,12 +441,19 @@ module elpa_impl
#else #else
call self%set("process_row", 0, error) call self%set("process_row", 0, error)
if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("process_col", 0, error) call self%set("process_col", 0, error)
if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("process_id", 0, error) 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) 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) 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) call self%set("num_process_cols", 1, error)
if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
call self%set("num_processes", 1, error) call self%set("num_processes", 1, error)
if(check_elpa_set(error, ELPA_ERROR_SETUP)) return
#endif #endif
end function end function
...@@ -478,6 +487,7 @@ module elpa_impl ...@@ -478,6 +487,7 @@ module elpa_impl
stop stop
endif endif
call self%get("blacs_context", blacs_ctx, error) call self%get("blacs_context", blacs_ctx, error)
if(check_elpa_get(error, ELPA_ERROR)) return
sc_desc(1) = 1 sc_desc(1) = 1
sc_desc(2) = blacs_ctx sc_desc(2) = blacs_ctx
...@@ -593,6 +603,7 @@ module elpa_impl ...@@ -593,6 +603,7 @@ module elpa_impl
nullify(string) nullify(string)
call self%get(option_name, val, actual_error) call self%get(option_name, val, actual_error)
if(check_elpa_get(error, ELPA_ERROR)) return
if (actual_error /= ELPA_OK) then if (actual_error /= ELPA_OK) then
if (present(error)) then if (present(error)) then
error = actual_error error = actual_error
...@@ -753,15 +764,9 @@ module elpa_impl ...@@ -753,15 +764,9 @@ module elpa_impl
#ifdef WITH_MPI #ifdef WITH_MPI
if (self%communicators_owned == 1) then if (self%communicators_owned == 1) then
call self%get("mpi_comm_rows", mpi_comm_rows,error) call self%get("mpi_comm_rows", mpi_comm_rows,error)
if (error .ne. ELPA_OK) then if(check_elpa_get(error, ELPA_ERROR)) return
print *,"Problem getting option. Aborting..."
stop
endif
call self%get("mpi_comm_cols", mpi_comm_cols,error) call self%get("mpi_comm_cols", mpi_comm_cols,error)
if (error .ne. ELPA_OK) then if(check_elpa_get(error, ELPA_ERROR)) return
print *,"Problem getting option. Aborting..."
stop
endif
write(error_unit, '(A,2I13)') "FREE comms", mpi_comm_rows, mpi_comm_cols write(error_unit, '(A,2I13)') "FREE comms", mpi_comm_rows, mpi_comm_cols
call mpi_comm_free(mpi_comm_rows, mpierr) call mpi_comm_free(mpi_comm_rows, mpierr)
...@@ -771,6 +776,7 @@ module elpa_impl ...@@ -771,6 +776,7 @@ module elpa_impl
return return
endif endif
call self%set("mpi_comm_cols", -12345,error) call self%set("mpi_comm_cols", -12345,error)
if(check_elpa_set(error, ELPA_ERROR)) return
call mpi_comm_free(mpi_comm_cols, mpierr) call mpi_comm_free(mpi_comm_cols, mpierr)
if (mpierr .ne. MPI_SUCCESS) then if (mpierr .ne. MPI_SUCCESS) then
call MPI_ERROR_STRING(mpierr,mpierr_string, mpi_string_length, mpierr2) call MPI_ERROR_STRING(mpierr,mpierr_string, mpi_string_length, mpierr2)
...@@ -778,6 +784,7 @@ module elpa_impl ...@@ -778,6 +784,7 @@ module elpa_impl
return return
endif endif
call self%set("mpi_comm_rows", -12345,error) call self%set("mpi_comm_rows", -12345,error)
if(check_elpa_set(error, ELPA_ERROR)) return
endif endif
#endif #endif
...@@ -1505,21 +1512,36 @@ module elpa_impl ...@@ -1505,21 +1512,36 @@ module elpa_impl
end subroutine end subroutine
subroutine check_elpa_get(error) function check_elpa(error, str, new_error) result(res)
integer :: error integer, intent(inout) :: error
integer, intent(in) :: new_error
character(*) :: str
logical :: res
if (error .ne. ELPA_OK) then if (error .ne. ELPA_OK) then
print *,"Problem getting option. Aborting..." print *, trim(str)
stop res = .true.
error = new_error
return
endif endif
end subroutine res = .false.
end function
function check_elpa_get(error, new_error) result(res)
integer, intent(inout) :: error
integer, intent(in) :: new_error
logical :: res
res = check_elpa(error, "Problem getting option. Aborting...", new_error)
return
end function
function check_elpa_set(error, new_error) result(res)
integer, intent(inout) :: error
integer, intent(in) :: new_error
logical :: res
res = check_elpa(error, "Problem setting option. Aborting...", new_error)
return
end function
subroutine check_elpa_set(error)
integer :: error
if (error .ne. ELPA_OK) then
print *,"Problem setting option. Aborting..."
stop
endif
end subroutine
#endif #endif
......
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