Commit aa9303c2 authored by Matthias Redies's avatar Matthias Redies

MPI fixes and error deflection to judfterror

parent 7ec5a5c9
......@@ -121,6 +121,7 @@ CONTAINS
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")
ELSEIF (PRESENT(int_data_ptr)) THEN
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr, int_data_ptr, (/length/type_size/))
......@@ -128,6 +129,7 @@ CONTAINS
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")
ELSE
#ifdef CPP_MPI_ALLOC
CALL C_F_POINTER(ptr, cmplx_data_ptr, (/length/type_size/))
......@@ -135,6 +137,7 @@ CONTAINS
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")
ENDIF
#endif
END SUBROUTINE priv_create_memory
......@@ -284,15 +287,16 @@ CONTAINS
SUBROUTINE sync_eig(id)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
INTEGER, INTENT(IN) :: id
TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
INTEGER:: err
#ifdef CPP_MPI3
#if defined(CPP_MPI3) && defined(CPP_MPI)
CALL priv_find_data(id, d)
call juDFT_error("TRAAAACE!")
IF (d%read_epoch) THEN
d%read_epoch = .FALSE.
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%eig_handle, err)
......
......@@ -89,6 +89,7 @@ CONTAINS
ALLOCATE(mpi%k_list(SIZE([(i, i=INT(mpi%irank/mpi%n_size)+1,nkpt,mpi%isize/mpi%n_size )])))
mpi%k_list=[(i, i=INT(mpi%irank/mpi%n_size)+1,nkpt,mpi%isize/mpi%n_size )]
call mpi%set_errhandler()
if (mpi%irank==0) WRITE(*,*) "--------------------------------------------------------"
END SUBROUTINE setupMPI
......
......@@ -18,6 +18,7 @@ MODULE m_types_mpi
!Communicator for PE on same node
INTEGER :: mpi_comm_same_node
CONTAINS
procedure :: set_errhandler => t_mpi_set_errhandler
procedure :: is_root => mpi_is_root
END TYPE t_mpi
contains
......@@ -27,4 +28,37 @@ contains
logical :: is_root
is_root = mpi%irank == 0
end function mpi_is_root
subroutine t_mpi_set_errhandler(self)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
class(t_mpi), intent(in) :: self
#ifdef CPP_MPI
integer :: err_handler, ierr
call MPI_Comm_create_errhandler(judft_mpi_error_handler, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't create Error handler")
call MPI_Comm_Set_Errhandler(MPI_COMM_WORLD, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't assign Error handler to MPI_COMM_WORLD")
call MPI_Comm_Set_Errhandler(self%mpi_comm, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't assign Error handler to self%mpi_comm")
call MPI_Comm_Set_Errhandler(self%sub_comm, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't assign Error handler to self%sub_comm")
#endif
end subroutine t_mpi_set_errhandler
subroutine judft_mpi_error_handler(comm, error_code)
use m_judft
implicit none
integer, intent(in) :: comm, error_code
call judft_error("MPI failed with Error_code = " // int2str(error_code))
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