Commit 37fa0d89 authored by Henning Janssen's avatar Henning Janssen

Merge remote-tracking branch 'origin/develop' into develop

parents 592aa56c eaa14328
......@@ -15,31 +15,33 @@ MODULE m_types_wannier
TYPE,EXTENDS(t_fleurinput_base):: t_wann
!New parameters not handled correctly yet...
LOGICAL :: l_socmatvec=.FALSE.
INTEGER :: socmatvecfmt=1
LOGICAL :: l_socmatvecrs=.FALSE.
INTEGER :: socmatvecrsfmt=1
LOGICAL :: l_mmn0_unf_to_spn_unf=.FALSE.
LOGICAL :: l_mmn0_to_spn_unf=.FALSE.
LOGICAL :: l_mmn0_to_spn=.FALSE.
LOGICAL :: l_mmn0_to_spn2=.FALSE.
LOGICAL :: l_mmn0_unf_to_spn=.FALSE.
LOGICAL :: l_perpmag_unf_to_tor_unf=.FALSE.
LOGICAL :: l_perpmag_to_tor_unf=.FALSE.
LOGICAL :: l_perpmag_to_tor=.FALSE.
LOGICAL :: l_perpmag_unf_to_tor=.FALSE.
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc_unf=.FALSE.
LOGICAL :: l_hsomtxvec_to_lmpzsoc_unf=.FALSE.
LOGICAL :: l_hsomtxvec_to_lmpzsoc=.FALSE.
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc=.FALSE.
LOGICAL :: l_hsomtx_unf_to_hsoc_unf=.FALSE.
LOGICAL :: l_hsomtx_to_hsoc_unf=.FALSE.
LOGICAL :: l_hsomtx_to_hsoc=.FALSE.
LOGICAL :: l_hsomtx_unf_to_hsoc=.FALSE.
INTEGER :: perpmagl
LOGICAL :: l_perpmagatlres=.FALSE.
LOGICAL :: l_mmn0_to_spn_unf=.FALSE.
LOGICAL :: l_mmn0_to_spn=.FALSE.
LOGICAL :: l_mmn0_to_spn2=.FALSE.
LOGICAL :: l_mmn0_unf_to_spn=.FALSE.
LOGICAL :: l_perpmag_unf_to_tor_unf=.FALSE.
LOGICAL :: l_perpmag_to_tor_unf=.FALSE.
LOGICAL :: l_perpmag_to_tor=.FALSE.
LOGICAL :: l_perpmag_unf_to_tor=.FALSE.
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc_unf=.FALSE.
LOGICAL :: l_hsomtxvec_to_lmpzsoc_unf=.FALSE.
LOGICAL :: l_hsomtxvec_to_lmpzsoc=.FALSE.
LOGICAL :: l_hsomtxvec_unf_to_lmpzsoc=.FALSE.
LOGICAL :: l_hsomtx_unf_to_hsoc_unf=.FALSE.
LOGICAL :: l_hsomtx_to_hsoc_unf=.FALSE.
LOGICAL :: l_hsomtx_to_hsoc=.FALSE.
LOGICAL :: l_hsomtx_unf_to_hsoc=.FALSE.
INTEGER :: perpmagl
LOGICAL :: l_perpmagatlres=.FALSE.
INTEGER :: wan90version =3
INTEGER :: oc_num_orbs =0
INTEGER, ALLOCATABLE :: oc_orbs(:)
LOGICAL :: l_unformatted =.FALSE.
INTEGER :: wan90version =3
INTEGER :: oc_num_orbs =0
INTEGER, ALLOCATABLE :: oc_orbs(:)
LOGICAL :: l_unformatted =.FALSE.
LOGICAL :: l_oc_f=.FALSE.
LOGICAL :: l_ndegen=.FALSE.
LOGICAL :: l_orbitalmom=.FALSE.
......@@ -50,7 +52,9 @@ MODULE m_types_wannier
LOGICAL :: l_perturb=.FALSE.
LOGICAL :: l_nedrho=.FALSE.
LOGICAL :: l_anglmomrs=.FALSE.
INTEGER :: anglmomrsfmt=1
LOGICAL :: l_anglmom=.FALSE.
INTEGER :: anglmomfmt=1
LOGICAL :: l_spindisp=.FALSE.
LOGICAL :: l_spindisprs=.FALSE.
LOGICAL :: l_socspicom=.FALSE.
......@@ -58,17 +62,25 @@ MODULE m_types_wannier
LOGICAL :: l_offdiposoprs=.FALSE.
LOGICAL :: l_offdiposop=.FALSE.
LOGICAL :: l_torque=.FALSE.
INTEGER :: torquefmt=1
LOGICAL :: l_torquers=.FALSE.
INTEGER :: torquersfmt=1
LOGICAL :: l_atomlist=.FALSE.
INTEGER :: atomlist_num=0
INTEGER, ALLOCATABLE :: atomlist(:)
LOGICAL :: l_berry=.FALSE.
LOGICAL :: l_perpmagrs=.FALSE.
INTEGER :: perpmagrsfmt=1
LOGICAL :: l_perpmag=.FALSE.
INTEGER :: perpmagfmt=1
LOGICAL :: l_perpmagat=.FALSE.
INTEGER :: perpmagatfmt=1
LOGICAL :: l_perpmagatrs=.FALSE.
INTEGER :: perpmagatrsfmt=1
LOGICAL :: l_socmatrs=.FALSE.
INTEGER :: socmatrsfmt=1
LOGICAL :: l_socmat=.FALSE.
INTEGER :: socmatfmt=1
LOGICAL :: l_soctomom=.FALSE.
LOGICAL :: l_kptsreduc2=.FALSE.
LOGICAL :: l_nablapaulirs=.FALSE.
......@@ -81,13 +93,16 @@ MODULE m_types_wannier
LOGICAL :: l_nabla=.FALSE.
LOGICAL :: l_socodi=.FALSE.
LOGICAL :: l_pauli=.FALSE.
INTEGER :: paulifmt=1
LOGICAL :: l_pauliat=.FALSE.
INTEGER :: pauliatfmt=1
LOGICAL :: l_potmat=.FALSE.
LOGICAL :: l_projgen=.FALSE.
LOGICAL :: l_plot_symm=.FALSE.
LOGICAL :: l_socmmn0=.FALSE.
LOGICAL :: l_bzsym=.FALSE.
LOGICAL :: l_hopping=.FALSE.
INTEGER :: hoppingfmt=1
LOGICAL :: l_kptsreduc=.FALSE.
LOGICAL :: l_prepwan90=.FALSE.
LOGICAL :: l_plot_umdat=.FALSE.
......@@ -95,7 +110,9 @@ MODULE m_types_wannier
LOGICAL :: l_bynumber=.FALSE.
LOGICAL :: l_stopopt=.FALSE.
LOGICAL :: l_matrixmmn=.FALSE.
INTEGER :: matrixmmnfmt=1
LOGICAL :: l_matrixamn=.FALSE.
INTEGER :: matrixamnfmt=1
LOGICAL :: l_projmethod=.FALSE.
LOGICAL :: l_wannierize=.FALSE.
LOGICAL :: l_plotw90=.FALSE.
......@@ -111,7 +128,9 @@ MODULE m_types_wannier
LOGICAL :: l_dipole2=.FALSE.
LOGICAL :: l_dipole3=.FALSE.
LOGICAL :: l_mmn0=.FALSE.
INTEGER :: mmn0fmt=1
LOGICAL :: l_mmn0at=.FALSE.
INTEGER :: mmn0atfmt=1
LOGICAL :: l_manyfiles=.FALSE.
LOGICAL :: l_collectmanyfiles=.FALSE.
LOGICAL :: l_ldauwan=.FALSE.
......@@ -123,7 +142,9 @@ MODULE m_types_wannier
LOGICAL :: l_finishgwf=.FALSE.
LOGICAL :: l_skipkov=.FALSE.
LOGICAL :: l_matrixuHu=.FALSE.
INTEGER :: matrixuHufmt=1
LOGICAL :: l_matrixuHu_dmi=.FALSE.
INTEGER :: matrixuHudmifmt=1
INTEGER :: ikptstart=1
INTEGER :: band_min(1:2)=-1
INTEGER :: band_max(1:2)=-1
......@@ -171,7 +192,27 @@ CONTAINS
ELSE
rank=0
END IF
CALL mpi_bc(this%socmatvecfmt,rank,mpi_comm)
CALL mpi_bc(this%socmatvecrsfmt,rank,mpi_comm)
CALL mpi_bc(this%anglmomrsfmt,rank,mpi_comm)
CALL mpi_bc(this%anglmomfmt,rank,mpi_comm)
CALL mpi_bc(this%torquefmt,rank,mpi_comm)
CALL mpi_bc(this%torquersfmt,rank,mpi_comm)
CALL mpi_bc(this%perpmagrsfmt,rank,mpi_comm)
CALL mpi_bc(this%perpmagfmt,rank,mpi_comm)
CALL mpi_bc(this%perpmagatfmt,rank,mpi_comm)
CALL mpi_bc(this%perpmagatrsfmt,rank,mpi_comm)
CALL mpi_bc(this%socmatrsfmt,rank,mpi_comm)
CALL mpi_bc(this%socmatfmt,rank,mpi_comm)
CALL mpi_bc(this%paulifmt,rank,mpi_comm)
CALL mpi_bc(this%pauliatfmt,rank,mpi_comm)
CALL mpi_bc(this%hoppingfmt,rank,mpi_comm)
CALL mpi_bc(this%matrixmmnfmt,rank,mpi_comm)
CALL mpi_bc(this%matrixamnfmt,rank,mpi_comm)
CALL mpi_bc(this%mmn0fmt,rank,mpi_comm)
CALL mpi_bc(this%mmn0atfmt,rank,mpi_comm)
CALL mpi_bc(this%matrixuHufmt,rank,mpi_comm)
CALL mpi_bc(this%matrixuHudmifmt,rank,mpi_comm)
CALL mpi_bc(this%wan90version ,rank,mpi_comm)
CALL mpi_bc(this%oc_num_orbs ,rank,mpi_comm)
CALL mpi_bc(this%oc_orbs,rank,mpi_comm)
......
......@@ -7,182 +7,180 @@
module m_eig66_data
#include "juDFT_env.h"
#ifdef CPP_HDF
use hdf5
use hdf5
#endif
implicit none
TYPE :: t_data
INTEGER:: io_mode
INTEGER:: jspins,nkpts,nmat,neig,nlo,ntype
LOGICAL:: l_real,l_soc
END TYPE
TYPE,EXTENDS(t_data):: t_data_DA
INTEGER :: recl_vec=0,recl_wiks
CHARACTER(LEN=20) :: fname="eig"
INTEGER :: file_io_id_vec,file_io_id_wiks
END TYPE
TYPE,extends(t_data):: t_data_MPI
LOGICAL :: read_epoch=.false.
INTEGER :: n_size=1
INTEGER :: size_k,size_eig
INTEGER :: eig_handle,zr_handle,zc_handle,neig_handle,w_iks_handle
INTEGER,ALLOCATABLE :: pe_basis(:,:),slot_basis(:,:)
INTEGER,ALLOCATABLE :: pe_ev(:,:,:),slot_ev(:,:,:)
INTEGER :: irank
INTEGER,POINTER :: neig_data(:)
REAL,POINTER :: eig_data(:),zr_data(:), w_iks_data(:)
COMPLEX,POINTER :: zc_data(:)
END TYPE
TYPE,EXTENDS(t_data):: t_data_hdf
implicit none
TYPE :: t_data
INTEGER:: io_mode
INTEGER:: jspins, nkpts, nmat, neig, nlo, ntype
LOGICAL:: l_real, l_soc
END TYPE
TYPE, EXTENDS(t_data):: t_data_DA
INTEGER :: recl_vec = 0, recl_wiks
CHARACTER(LEN=20) :: fname = "eig"
INTEGER :: file_io_id_vec, file_io_id_wiks
END TYPE
TYPE, extends(t_data):: t_data_MPI
LOGICAL :: read_epoch = .false.
INTEGER :: n_size = 1
INTEGER :: size_k, size_eig
INTEGER :: eig_handle, zr_handle, zc_handle, neig_handle, w_iks_handle
INTEGER, ALLOCATABLE :: pe_basis(:, :), slot_basis(:, :)
INTEGER, ALLOCATABLE :: pe_ev(:, :, :), slot_ev(:, :, :)
INTEGER :: irank
INTEGER, POINTER :: neig_data(:)
REAL, POINTER :: eig_data(:), zr_data(:), w_iks_data(:)
COMPLEX, POINTER :: zc_data(:)
END TYPE
TYPE, EXTENDS(t_data):: t_data_hdf
#ifdef CPP_HDF
INTEGER(HID_T) :: fid
INTEGER(HID_T) :: neigsetid
INTEGER(HID_T) :: energysetid,wikssetid,evsetid
CHARACTER(LEN=20) :: fname="eig"
INTEGER(HID_T) :: fid
INTEGER(HID_T) :: neigsetid
INTEGER(HID_T) :: energysetid, wikssetid, evsetid
CHARACTER(LEN=20) :: fname = "eig"
#endif
END TYPE
TYPE,EXTENDS(t_data):: t_data_mem
INTEGER,ALLOCATABLE :: eig_int(:)
REAL,ALLOCATABLE :: eig_eig(:,:,:)
REAL,ALLOCATABLE :: eig_vecr(:,:)
COMPLEX,ALLOCATABLE :: eig_vecc(:,:)
END TYPE
TYPE t_list
INTEGER :: id
CLASS(t_data),POINTER :: data
TYPE(t_list),POINTER :: next=>null()
END TYPE
TYPE(t_list),POINTER :: linked_list=>null()
private linked_list
INTEGER, PARAMETER :: DA_mode=0,HDF_mode=1,MEM_mode=2,MPI_mode=3
contains
subroutine eig66_data_storedefault(d,jspins,nkpts,nmat,neig,l_real,l_soc)
CLASS(t_data)::d
INTEGER,INTENT(IN)::jspins,nkpts,nmat,neig
LOGICAL,INTENT(IN):: l_real,l_soc
d%jspins=jspins
d%nkpts=nkpts
d%nmat=nmat
d%neig=neig
d%l_real=l_real
d%l_soc=l_soc
END SUBROUTINE
subroutine eig66_find_data(d,id,io_mode)
IMPLICIT NONE
INTEGER,INTENT(IN) ::id
INTEGER,INTENT(IN),OPTIONAL :: io_mode
CLASS(t_data),pointer::d
TYPE(t_list),POINTER,ASYNCHRONOUS:: listpointer,lastinlist
lastinlist=>null()
listpointer=>linked_list
DO WHILE(associated(listpointer))
lastinlist=>listpointer
if (listpointer%id==id) THEN
d=>listpointer%data
return
endif
listpointer=>listpointer%next
enddo
!no pointer found
IF (present(io_mode)) THEN
IF (.not.associated(lastinlist)) THEN
allocate(linked_list)
linked_list%id=id
lastinlist=>linked_list
ELSE
allocate(lastinlist%next)
lastinlist%next%id=id
lastinlist=>lastinlist%next
ENDIF
SELECT CASE (io_mode)
END TYPE
TYPE, EXTENDS(t_data):: t_data_mem
INTEGER, ALLOCATABLE :: eig_int(:)
REAL, ALLOCATABLE :: eig_eig(:, :, :)
REAL, ALLOCATABLE :: eig_vecr(:, :)
COMPLEX, ALLOCATABLE :: eig_vecc(:, :)
END TYPE
TYPE t_list
INTEGER :: id
CLASS(t_data), POINTER :: data
TYPE(t_list), POINTER :: next => null()
END TYPE
TYPE(t_list), POINTER :: linked_list => null()
private linked_list
INTEGER, PARAMETER :: DA_mode = 0, HDF_mode = 1, MEM_mode = 2, MPI_mode = 3
contains
subroutine eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
CLASS(t_data)::d
INTEGER, INTENT(IN)::jspins, nkpts, nmat, neig
LOGICAL, INTENT(IN):: l_real, l_soc
d%jspins = jspins
d%nkpts = nkpts
d%nmat = nmat
d%neig = neig
d%l_real = l_real
d%l_soc = l_soc
END SUBROUTINE
subroutine eig66_find_data(d, id, io_mode)
IMPLICIT NONE
INTEGER, INTENT(IN) ::id
INTEGER, INTENT(IN), OPTIONAL :: io_mode
CLASS(t_data), pointer::d
TYPE(t_list), POINTER, ASYNCHRONOUS:: listpointer, lastinlist
lastinlist => null()
listpointer => linked_list
DO WHILE (associated(listpointer))
lastinlist => listpointer
if (listpointer%id == id) THEN
d => listpointer%data
return
endif
listpointer => listpointer%next
enddo
!no pointer found
IF (present(io_mode)) THEN
IF (.not. associated(lastinlist)) THEN
allocate (linked_list)
linked_list%id = id
lastinlist => linked_list
ELSE
allocate (lastinlist%next)
lastinlist%next%id = id
lastinlist => lastinlist%next
ENDIF
SELECT CASE (io_mode)
case (DA_MODE)
allocate(t_data_DA::lastinlist%data)
allocate (t_data_DA::lastinlist%data)
case (HDF_MODE)
#ifdef CPP_HDF
allocate(t_data_HDF::lastinlist%data)
allocate (t_data_HDF::lastinlist%data)
#else
call juDFT_error("Cannot use hdf mode for IO, recompile with CPP_HDF",calledby="eig66_data")
call juDFT_error("Cannot use hdf mode for IO, recompile with CPP_HDF", calledby="eig66_data")
#endif
case (MEM_MODE)
allocate(t_data_MEM::lastinlist%data)
allocate (t_data_MEM::lastinlist%data)
case (MPI_MODE)
allocate(t_data_MPI::lastinlist%data)
allocate (t_data_MPI::lastinlist%data)
end select
lastinlist%data%io_mode=io_mode
d=>lastinlist%data
ELSE
call juDFT_error("BUG:Could not find data object in eig66_mpi")
ENDIF
END SUBROUTINE
subroutine eig66_remove_data(id)
INTEGER,INTENT(IN)::id
TYPE(t_list),POINTER:: listpointer,lastpointer
lastpointer=>null()
listpointer=>linked_list
loop:DO WHILE(associated(listpointer))
IF (listpointer%id==id) THEN
exit loop
lastinlist%data%io_mode = io_mode
d => lastinlist%data
ELSE
call juDFT_error("BUG:Could not find data object in eig66_mpi")
ENDIF
lastpointer=>listpointer
listpointer=>listpointer%next
ENDDO loop
if (.not.associated(listpointer)) call juDFT_error("BUG in eig66_data: ID not found in deleting")
IF (associated(lastpointer)) THEN
lastpointer%next=>listpointer%next
ELSE
linked_list=>listpointer%next
ENDIF
deallocate(listpointer)
end subroutine
INTEGER FUNCTION eig66_data_newid(mode)
INTEGER,INTENT(IN) :: mode
TYPE(t_list),POINTER:: listpointer
INTEGER :: id
CLASS(t_data),POINTER::d
id=0
listpointer=>linked_list
DO WHILE(associated(listpointer))
id=max(id,listpointer%id)
listpointer=>listpointer%next
ENDDO
eig66_data_newid=id+1
call eig66_find_data(d,id+1,mode)
end function
INTEGER function eig66_data_mode(id)RESULT(mode)
INTEGER,INTENT(IN) :: id
TYPE(t_list),POINTER:: listpointer
mode=-1
listpointer=>linked_list
DO WHILE(associated(listpointer))
if (id==listpointer%id) THEN
mode=listpointer%data%io_mode
return
ENDIF
listpointer=>listpointer%next
ENDDO
END FUNCTION
END SUBROUTINE
subroutine eig66_remove_data(id)
INTEGER, INTENT(IN)::id
TYPE(t_list), POINTER:: listpointer, lastpointer
lastpointer => null()
listpointer => linked_list
loop: DO WHILE (associated(listpointer))
IF (listpointer%id == id) THEN
exit loop
ENDIF
lastpointer => listpointer
listpointer => listpointer%next
ENDDO loop
if (.not. associated(listpointer)) call juDFT_error("BUG in eig66_data: ID not found in deleting")
IF (associated(lastpointer)) THEN
lastpointer%next => listpointer%next
ELSE
linked_list => listpointer%next
ENDIF
deallocate (listpointer)
end subroutine
INTEGER FUNCTION eig66_data_newid(mode)
INTEGER, INTENT(IN) :: mode
TYPE(t_list), POINTER:: listpointer
INTEGER :: id
CLASS(t_data), POINTER::d
id = 0
listpointer => linked_list
DO WHILE (associated(listpointer))
id = max(id, listpointer%id)
listpointer => listpointer%next
ENDDO
eig66_data_newid = id + 1
call eig66_find_data(d, id + 1, mode)
end function
INTEGER function eig66_data_mode(id) RESULT(mode)
INTEGER, INTENT(IN) :: id
TYPE(t_list), POINTER:: listpointer
mode = -1
listpointer => linked_list
DO WHILE (associated(listpointer))
if (id == listpointer%id) THEN
mode = listpointer%data%io_mode
return
ENDIF
listpointer => listpointer%next
ENDDO
END FUNCTION
end module m_eig66_data
......@@ -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
......
This diff is collapsed.
......@@ -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