Commit 14a55602 authored by Matthias Redies's avatar Matthias Redies

Add error handler to windows

parent aa9303c2
......@@ -49,7 +49,7 @@ CONTAINS
INTEGER, ALLOCATABLE :: my_k_list(:), k_owner(:)
CALL timestart("hybrid code")
call sync_eig(eig_id)
call sync_eig(eig_id, fi)
call hybmpi%copy_mpi(mpi)
call split_k_to_comm(fi, hybmpi, my_k_list, k_owner)
......@@ -139,7 +139,7 @@ CONTAINS
call timestop("Hybrid imbalance")
#endif
call sync_eig(eig_id)
call sync_eig(eig_id, fi)
CALL timestop("hybrid code")
CONTAINS
subroutine first_iteration_alloc(fi, hybdat)
......
......@@ -81,6 +81,7 @@ CONTAINS
CALL timestop("create data spaces in ei66_mpi")
CONTAINS
SUBROUTINE priv_create_memory(slot_size, local_slots, handle, int_data_ptr, real_data_ptr, cmplx_data_ptr)
use m_types_mpi, only: judft_win_create
IMPLICIT NONE
INTEGER, INTENT(IN) :: slot_size, local_slots
INTEGER, POINTER, OPTIONAL, ASYNCHRONOUS :: int_data_ptr(:)
......@@ -120,24 +121,21 @@ CONTAINS
#else
ALLOCATE (real_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(real_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle, e)
if(e /= 0) call judft_error("Can't create MPI_Win for real_data_ptr")
call judft_win_create(real_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
ELSEIF (PRESENT(int_data_ptr)) THEN
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr, int_data_ptr, (/length/type_size/))
#else
ALLOCATE (int_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(int_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle, e)
if(e /= 0) call judft_error("Can't create MPI_Win for int_data_ptr")
call judft_win_create(int_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
ELSE
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr, cmplx_data_ptr, (/length/type_size/))
#else
ALLOCATE (cmplx_data_ptr(length))
#endif
CALL MPI_WIN_CREATE(cmplx_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle, e)
if(e /= 0) call judft_error("Can't create MPI_Win for cmplx_data_ptr")
call judft_win_create(cmplx_data_ptr, length*type_size, slot_size*type_size, Mpi_INFO_NULL, MPI_COMM, handle)
ENDIF
#endif
END SUBROUTINE priv_create_memory
......@@ -285,26 +283,36 @@ CONTAINS
#endif
END SUBROUTINE read_eig
SUBROUTINE sync_eig(id)
SUBROUTINE sync_eig(id, fi)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
type(t_fleurinput) :: fi
INTEGER, INTENT(IN) :: id
logical :: l_real, l_soc
TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
INTEGER:: err
#if defined(CPP_MPI3) && defined(CPP_MPI)
CALL priv_find_data(id, d)
l_real=fi%sym%invs.AND..NOT.fi%noco%l_noco.AND..NOT.(fi%noco%l_soc.AND.fi%atoms%n_u+fi%atoms%n_hia>0)
l_soc =fi%noco%l_soc
IF (d%read_epoch) THEN
d%read_epoch = .FALSE.
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 1")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 2")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 3")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 2")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 3")
ENDIF
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 4")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%w_iks_handle, err)
......@@ -313,10 +321,13 @@ CONTAINS
d%read_epoch = .TRUE.
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 6")
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 7")
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 8")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 7")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 8")
ENDIF
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 9")
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%w_iks_handle, err)
......
......@@ -21,6 +21,13 @@ MODULE m_types_mpi
procedure :: set_errhandler => t_mpi_set_errhandler
procedure :: is_root => mpi_is_root
END TYPE t_mpi
INTERFACE juDFT_win_create
MODULE PROCEDURE juDFT_win_create_real, juDFT_win_create_cmplx, juDFT_win_create_int
END INTERFACE juDFT_win_create
PRIVATE
PUBLIC :: juDFT_win_create, t_mpi
contains
function mpi_is_root(mpi) result(is_root)
implicit none
......@@ -29,6 +36,81 @@ contains
is_root = mpi%irank == 0
end function mpi_is_root
subroutine juDFT_win_create_real(base, size, disp_unit, info, comm, win)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
real, POINTER, ASYNCHRONOUS, intent(inout) :: base(:)
integer, intent(in) :: disp_unit, info, comm
integer, intent(inout) :: win
#ifdef CPP_MPI
INTEGER(KIND=MPI_ADDRESS_KIND) :: SIZE
integer :: err, err_handler
CALL MPI_WIN_CREATE(base, size, disp_unit, info, comm, win, err)
if(err /= 0) call judft_error("Can't create MPI_Win for real_data_ptr")
call MPI_Win_create_errhandler(judft_mpi_error_handler, err_handler, err)
if(err /= 0) call judft_error("Can't create Error handler")
CALL MPI_WIN_SET_ERRHANDLER(win, err_handler, err)
if(err /= 0) call judft_error("Can't assign Error handler to Win")
#endif
end subroutine juDFT_win_create_real
subroutine juDFT_win_create_cmplx(base, size, disp_unit, info, comm, win)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
complex, POINTER, ASYNCHRONOUS, intent(inout):: base(:)
integer, intent(in) :: disp_unit, info, comm
integer, intent(inout) :: win
#ifdef CPP_MPI
INTEGER(KIND=MPI_ADDRESS_KIND) :: SIZE
integer :: err, err_handler
CALL MPI_WIN_CREATE(base, size, disp_unit, info, comm, win, err)
if(err /= 0) call judft_error("Can't create MPI_Win for cmplx_data_ptr")
call MPI_Win_create_errhandler(judft_mpi_error_handler, err_handler, err)
if(err /= 0) call judft_error("Can't create Error handler")
CALL MPI_WIN_SET_ERRHANDLER(win, err_handler, err)
if(err /= 0) call judft_error("Can't assign Error handler to Win")
#endif
end subroutine juDFT_win_create_cmplx
subroutine juDFT_win_create_int(base, size, disp_unit, info, comm, win)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
integer, POINTER, ASYNCHRONOUS, intent(inout) :: base(:)
integer, intent(in) :: disp_unit, info, comm
integer, intent(inout) :: win
#ifdef CPP_MPI
INTEGER(KIND=MPI_ADDRESS_KIND) :: SIZE
integer :: err, err_handler
CALL MPI_WIN_CREATE(base, size, disp_unit, info, comm, win, err)
if(err /= 0) call judft_error("Can't create MPI_Win for cmplx_data_ptr")
call MPI_Win_create_errhandler(judft_mpi_error_handler, err_handler, err)
if(err /= 0) call judft_error("Can't create Error handler")
CALL MPI_WIN_SET_ERRHANDLER(win, err_handler, err)
if(err /= 0) call judft_error("Can't assign Error handler to Win")
#endif
end subroutine juDFT_win_create_int
subroutine t_mpi_set_errhandler(self)
use m_judft
#ifdef CPP_MPI
......@@ -55,10 +137,19 @@ contains
end subroutine t_mpi_set_errhandler
subroutine judft_mpi_error_handler(comm, error_code)
#ifdef CPP_MPI
use mpi
#endif
use m_judft
implicit none
integer, intent(in) :: comm, error_code
integer :: str_len, ierr
character(len=3000) :: error_str
call judft_error("MPI failed with Error_code = " // int2str(error_code))
#ifdef CPP_MPI
call MPI_ERROR_STRING(error_code, error_str, str_len, ierr)
call judft_error("MPI failed with Error_code = " // int2str(error_code) // new_line("A") // &
error_str(1:str_len))
#endif
end subroutine judft_mpi_error_handler
END MODULE m_types_mpi
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