From f20d075c67c6b1822d475aa68a8a326ad11fbcae Mon Sep 17 00:00:00 2001 From: Daniel Wortmann Date: Sat, 13 Jul 2019 19:20:15 +0200 Subject: [PATCH] Started modifying mpi-type, adjusted k-loops --- eigen/eigen.F90 | 6 +++--- eigen_soc/eigenso.F90 | 26 +++++--------------------- hybrid/hybrid.F90 | 4 ++-- mpi/setupMPI.F90 | 24 ++++++++++++++++-------- types/types_mpi.F90 | 9 +++++---- 5 files changed, 31 insertions(+), 38 deletions(-) diff --git a/eigen/eigen.F90 b/eigen/eigen.F90 index a42fdea7..20c84890 100644 --- a/eigen/eigen.F90 +++ b/eigen/eigen.F90 @@ -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") diff --git a/eigen_soc/eigenso.F90 b/eigen_soc/eigenso.F90 index 93d5462b..23df5dff 100644 --- a/eigen_soc/eigenso.F90 +++ b/eigen_soc/eigenso.F90 @@ -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) diff --git a/hybrid/hybrid.F90 b/hybrid/hybrid.F90 index fc811bad..76c4fa2b 100644 --- a/hybrid/hybrid.F90 +++ b/hybrid/hybrid.F90 @@ -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) diff --git a/mpi/setupMPI.F90 b/mpi/setupMPI.F90 index f22825b3..b2bca90c 100644 --- a/mpi/setupMPI.F90 +++ b/mpi/setupMPI.F90 @@ -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 diff --git a/types/types_mpi.F90 b/types/types_mpi.F90 index 3d1aa6dc..bc1d781b 100644 --- a/types/types_mpi.F90 +++ b/types/types_mpi.F90 @@ -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 -- 2.26.2