Commit f20d075c authored by Daniel Wortmann's avatar Daniel Wortmann

Started modifying mpi-type, adjusted k-loops

parent ea09cca8
......@@ -74,7 +74,7 @@ CONTAINS
INTEGER,INTENT(IN) :: eig_id
! Local Scalars
INTEGER jsp,nk,nred,ne_all,ne_found
INTEGER jsp,nk,nred,ne_all,ne_found,nk_i
INTEGER ne,lh0
INTEGER isp,i,j,err
LOGICAL l_wu,l_file,l_real,l_zref
......@@ -132,8 +132,8 @@ CONTAINS
unfoldingBuffer = CMPLX(0.0,0.0)
DO jsp = 1,MERGE(1,input%jspins,noco%l_noco)
k_loop:DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
k_loop:DO nk_i = 1,size(mpi%k_list)
nk=mpi%k_list(i)
! Set up lapw list
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref, mpi)
call timestart("Setup of H&S matrices")
......
......@@ -60,9 +60,9 @@ CONTAINS
! ..
! ..
! .. Local Scalars ..
INTEGER i,j,nk,jspin,n ,l
INTEGER i,j,nk,nk_i,jspin,n ,l
! INTEGER n_loc,n_plus,i_plus,
INTEGER n_end,nsz,nmat,n_stride
INTEGER nsz,nmat,n_stride
LOGICAL l_socvec !,l_all
INTEGER wannierspin
TYPE(t_usdus) :: usdus
......@@ -129,25 +129,9 @@ CONTAINS
CALL timestop("eigenso: spnorb")
!
!---> loop over k-points: each can be a separate task
!
!n_loc = INT(kpts%nkpt/mpi%isize)
!n_plus = kpts%nkpt - mpi%isize*n_loc
!i_plus = -1
!IF (mpi%irank.LT.n_plus) i_plus = 0
!n_end = (mpi%irank+1)+(n_loc+i_plus)*mpi%isize
!
#if defined(CPP_MPI)
n_stride = kpts%nkpt/mpi%n_groups
#else
n_stride = 1
#endif
n_end = kpts%nkpt
!write(*,'(4i12)') mpi%irank, mpi%n_groups, n_stride, mpi%n_start
!
!---> start loop k-pts
!
! DO nk = mpi%irank+1,n_end,mpi%isize
DO nk = mpi%n_start,n_end,n_stride
!DO nk_i=1,SIZE(mpi%k_list)
nk=mpi%k_list(nk_i)
!DO nk = mpi%n_start,n_end,n_stride
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,.FALSE., mpi)
ALLOCATE( zso(lapw%nv(1)+atoms%nlotot,2*DIMENSION%neigd,wannierspin))
zso(:,:,:) = CMPLX(0.0,0.0)
......
......@@ -127,8 +127,8 @@ CONTAINS
call timestop("HF_setup")
DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
DO nk = 1,kpts%nkpt
!DO nk = mpi%n_start,kpts%nkpt,mpi%n_stride
CALL lapw%init(input,noco, kpts,atoms,sym,nk,cell,l_zref)
CALL hsfock(nk,atoms,hybrid,lapw,DIMENSION,kpts,jsp,input,hybdat,eig_irr,sym,cell,&
noco,results,iterHF,MAXVAL(hybrid%nobd),xcpot,mpi)
......
......@@ -16,7 +16,7 @@ CONTAINS
INTEGER,INTENT(in) :: nkpt
TYPE(t_mpi),INTENT(inout) :: mpi
integer :: omp=-1
INTEGER :: omp=-1,i
!$ omp=omp_get_max_threads()
if (mpi%irank==0) THEN
......@@ -39,12 +39,14 @@ CONTAINS
IF (mpi%isize==1) THEN
!give some info on available parallelisation
CALL priv_dist_info(nkpt)
mpi%n_start=1
mpi%n_stride=1
mpi%n_rank=0
mpi%n_size=1
mpi%n_groups=1
mpi%sub_comm=mpi%mpi_comm
IF (ALLOCATED(kpts%k_list)) DEALLOCATE(mpi%k_List,mpi%ev_list))
ALLOCATE(mpi%k_list(kpts%nkpts))
mpi%k_list=[(i,i=1,kpts%nkpts)]
ALLOCATE(mpi%ev_list(neigd))
mpi%ev_list=[(i,i=1,neigd)]
END IF
#ifdef CPP_MPI
!Distribute the work
......@@ -107,13 +109,16 @@ CONTAINS
IF ((MOD(mpi%isize,n_members) == 0).AND.(MOD(nkpt,n_members) == 0) ) EXIT
n_members = n_members - 1
ENDDO
mpi%n_groups = nkpt/n_members
ALLOCATE(mpi%k_list(nkpt/n_members))
mpi%k_list=[(nk, nk=nkpt/n_members,nkpt,n_members )]
!mpi%n_groups = nkpt/n_members
mpi%n_size = mpi%isize/n_members
mpi%n_stride = n_members
!mpi%n_stride = n_members
IF (mpi%irank == 0) THEN
WRITE(*,*) 'k-points in parallel: ',n_members
WRITE(*,*) "pe's per k-point: ",mpi%n_size
WRITE(*,*) '# of k-point loops: ',mpi%n_groups
WRITE(*,*) '# of k-point loops: ',nkpt/n_members
ENDIF
END SUBROUTINE priv_distribute_k
......@@ -128,7 +133,7 @@ CONTAINS
LOGICAL :: compact ! Deside how to distribute k-points
compact = .true.
n_members = nkpt/mpi%n_groups
n_members = mpi%isize/mpi%n_size
! now, we make the groups
......@@ -188,6 +193,9 @@ CONTAINS
!write (*,"(a,i0,100i4)") "MPI:",mpi%sub_comm,mpi%irank,mpi%n_groups,mpi%n_size,n,i_mygroup
CALL MPI_COMM_RANK (mpi%SUB_COMM,mpi%n_rank,ierr)
ALLOCATE(mpi%ev_list(neig/mpi%n_size+1))
mpi%ev_list=[(i,i=mpi%irank+1,neig,mpi%n_size)]
#endif
END SUBROUTINE priv_create_comm
......
......@@ -5,14 +5,15 @@
!--------------------------------------------------------------------------------
MODULE m_types_mpi
TYPE t_mpi
!k-point parallelism
INTEGER :: mpi_comm !< replaces MPI_COMM_WORLD
INTEGER :: irank !< rank of task in mpi_comm
INTEGER :: isize !< no of tasks in mpi_comm
INTEGER :: n_start !< no of first k-point to calculate on this PE
INTEGER :: n_stride !< stride for k-loops
INTEGER :: n_size !< PE per kpoint, i.e. "isize" for eigenvalue parallelization
INTEGER :: n_groups !< No of k-loops per PE
INTEGER,ALLOCATABLE :: k_list(:)
!Eigenvalue parallelism
INTEGER :: sub_comm !< Sub-Communicator for eigenvalue parallelization (all PE working on same k-point)
INTEGER :: n_rank !< rank in sub_comm
INTEGER :: n_size !< PE per kpoint, i.e. "isize" for eigenvalue parallelization
INTEGER,ALLOCATABLE :: ev_list(:)
END TYPE t_mpi
END MODULE m_types_mpi
  • Is this the correct branch? It seems there is a lot of this wrong with it.

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