Commit 1b2a0d34 authored by Matthias Redies's avatar Matthias Redies

create wrappers for everything that can create comm or win

parent 02f72e37
......@@ -215,6 +215,7 @@ CONTAINS
END SUBROUTINE
SUBROUTINE fleur_job_distribute(jobs)
use m_types_mpi
TYPE(t_job),INTENT(INOUT)::jobs(:)
#ifdef CPP_MPI
INCLUDE 'mpif.h'
......@@ -251,7 +252,7 @@ CONTAINS
IF ((irank.GE.min_pe).AND.(irank<min_pe+jobs(i)%PE_requested)) EXIT
ENDDO
jobs%mpi_comm=MPI_UNDEFINED
CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,i,irank,new_comm,ierr)
CALL judft_comm_split(MPI_COMM_WORLD,i,irank,new_comm)
IF (i.LE.size(jobs)) THEN
if(size(jobs) > 1) PRINT* ,"PE:",irank," works on job ",i," in ",jobs(i)%directory
jobs(i)%mpi_comm=new_comm
......
......@@ -406,7 +406,7 @@ CONTAINS
IF (isize == 1) RETURN !No parallelization
js = MERGE(jspins, 3,.NOT. l_noco)!distribute spins
js = MIN(js, isize)
CALL MPI_COMM_SPLIT(mpi_comm, MOD(irank, js), irank, new_comm, err)
CALL judft_comm_split(mpi_comm, MOD(irank, js), irank, new_comm)
spin_here = (/MOD(irank, js) == 0, MOD(irank, js) == 1, (isize == 2 .AND. irank == 0) .OR. MOD(irank, js) == 2/)
CALL mpi_comm_rank(new_comm, irank, err)
......
......@@ -23,7 +23,7 @@ CONTAINS
INTEGER :: omp=-1,i,isize,localrank,gpus,ii
#ifdef CPP_MPI
include 'mpif.h'
CALL MPI_COMM_SPLIT_TYPE(mpi%mpi_comm,MPI_COMM_TYPE_SHARED,0,MPI_INFO_NULL,mpi%mpi_comm_same_node,i)
CALL juDFT_COMM_SPLIT_TYPE(mpi%mpi_comm,MPI_COMM_TYPE_SHARED,0,MPI_INFO_NULL,mpi%mpi_comm_same_node)
#endif
call omp_checker()
!$ omp=omp_get_max_threads()
......
......@@ -12,7 +12,6 @@ MODULE m_types_hybmpi
contains
procedure :: copy_mpi => t_hybmpi_copy_mpi
procedure :: barrier => t_hybmpi_barrier
procedure :: split => t_hybmpi_split
END TYPE t_hybmpi
contains
subroutine t_hybmpi_copy_mpi(hybmpi, mpi)
......@@ -26,27 +25,6 @@ contains
hybmpi%rank = mpi%irank
end subroutine
subroutine t_hybmpi_split(hybmpi, color, key)
use m_judft
implicit NONE
class(t_hybmpi), intent(inout) :: hybmpi
integer, intent(in) :: color
integer, intent(in), optional :: key
integer :: ierr, use_key
#ifdef CPP_MPI
use_key = MERGE(key, hybmpi%rank, present(key))
allocate(hybmpi%subcomm)
call MPI_Comm_split(hybmpi%comm, color, use_key, hybmpi%subcomm, ierr)
if(ierr /= 0) call judft_error("MPI splitting failed")
call MPI_comm_rank(hybmpi%subcomm, hybmpi%subcomm%rank, ierr)
if(ierr /= 0) call judft_error("MPI ranking failed")
call MPI_comm_size(hybmpi%subcomm, hybmpi%subcomm%size, ierr)
if(ierr /= 0) call judft_error("MPI sizing failed")
#endif
end subroutine t_hybmpi_split
subroutine t_hybmpi_barrier(hybmpi)
use m_judft
implicit none
......
......@@ -27,7 +27,7 @@ MODULE m_types_mpi
END INTERFACE juDFT_win_create
PRIVATE
PUBLIC :: juDFT_win_create, t_mpi
PUBLIC :: juDFT_win_create, judft_comm_split, judft_comm_split_type, t_mpi
contains
function mpi_is_root(mpi) result(is_root)
implicit none
......@@ -117,6 +117,50 @@ contains
#endif
end subroutine juDFT_win_create_int
subroutine judft_comm_split(comm, color, key, new_comm)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
integer, intent(in) :: comm, color, key
integer, intent(inout) :: new_comm
#ifdef CPP_MPI
integer :: ierr, err_handler
CALL MPI_COMM_SPLIT(comm,color,key,new_comm,ierr)
if(ierr /= 0) call judft_error("Can't split comm")
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(new_comm, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't assign Error handler to new_comm")
#endif
end subroutine judft_comm_split
subroutine judft_comm_split_type(comm, split_type, key, info, new_comm)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
implicit none
integer, intent(in) :: comm, split_type, key, info
integer, intent(inout) :: new_comm
integer :: ierr, err_handler
#ifdef CPP_MPI
call MPI_comm_split_type(comm, split_type, key, info, new_comm, ierr)
if(ierr /= 0) call judft_error("Can't split comm")
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(new_comm, err_handler, ierr)
if(ierr /= 0) call judft_error("Can't assign Error handler to new_comm")
#endif
end subroutine judft_comm_split_type
subroutine t_mpi_set_errhandler(self)
use m_judft
#ifdef CPP_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