diff --git a/PW/src/set_rhoc.f90 b/PW/src/set_rhoc.f90 index 6f33d6146..5ee8205a3 100644 --- a/PW/src/set_rhoc.f90 +++ b/PW/src/set_rhoc.f90 @@ -27,7 +27,7 @@ subroutine set_rhoc USE lsda_mod, ONLY : nspin USE vlocal, ONLY : strf USE control_flags, ONLY : gamma_only - USE mp_global, ONLY : intra_pool_comm + USE mp_global, ONLY : intra_bgrp_comm USE mp, ONLY : mp_sum ! implicit none @@ -121,10 +121,10 @@ subroutine set_rhoc enddo rhoneg = rhoneg / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3) rhoima = rhoima / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3) -#ifdef __MPI - call mp_sum( rhoneg, intra_pool_comm ) - call mp_sum( rhoima, intra_pool_comm ) -#endif + ! + call mp_sum( rhoneg, intra_bgrp_comm ) + call mp_sum( rhoima, intra_bgrp_comm ) + ! IF (rhoneg < -1.0d-6 .OR. rhoima > 1.0d-6) & WRITE( stdout, '(/5x,"Check: negative/imaginary core charge=",2f12.6)')& rhoneg, rhoima diff --git a/PW/src/stres_hub.f90 b/PW/src/stres_hub.f90 index d6d6ee999..8d1cb8a08 100644 --- a/PW/src/stres_hub.f90 +++ b/PW/src/stres_hub.f90 @@ -142,7 +142,7 @@ SUBROUTINE dndepsilon ( dns,ldim,ipol,jpol ) USE io_files, ONLY : iunigk, nwordwfc, iunwfc, & iunat, iunsat, nwordatwfc USE buffers, ONLY : get_buffer - USE mp_global, ONLY : intra_pool_comm, inter_pool_comm + USE mp_global, ONLY : inter_pool_comm USE mp, ONLY : mp_sum IMPLICIT NONE @@ -234,10 +234,8 @@ SUBROUTINE dndepsilon ( dns,ldim,ipol,jpol ) END IF END DO END DO ! on k-points - -#ifdef __MPI + ! CALL mp_sum( dns, inter_pool_comm ) -#endif ! ! In nspin.eq.1 k-point weight wg is normalized to 2 el/band ! in the whole BZ but we are interested in dns of one spin component @@ -286,7 +284,7 @@ SUBROUTINE dprojdepsilon_k ( wfcatom, spsi, ik, ipol, jpol, dproj ) USE uspp_param, ONLY : upf, nhm, nh USE wavefunctions_module, ONLY : evc USE becmod, ONLY : bec_type, becp, calbec - USE mp_global, ONLY : intra_pool_comm + USE mp_global, ONLY : intra_bgrp_comm USE mp, ONLY : mp_sum IMPLICIT NONE @@ -405,11 +403,11 @@ SUBROUTINE dprojdepsilon_k ( wfcatom, spsi, ik, ipol, jpol, dproj ) wfatdbeta(iwf,ih)= zdotc(npw,wfcatom(1,iwf),1,dbeta(1,jkb2),1) END DO END DO -#ifdef __MPI - CALL mp_sum( dbetapsi, intra_pool_comm ) - CALL mp_sum( wfatbeta, intra_pool_comm ) - CALL mp_sum( wfatdbeta, intra_pool_comm ) -#endif + ! + CALL mp_sum( dbetapsi, intra_bgrp_comm ) + CALL mp_sum( wfatbeta, intra_bgrp_comm ) + CALL mp_sum( wfatdbeta, intra_bgrp_comm ) + ! DO ibnd = 1,nbnd DO ih=1,nh(nt) DO jh = 1,nh(nt) @@ -455,7 +453,7 @@ SUBROUTINE dprojdepsilon_gamma ( wfcatom, spsi, ipol, jpol, dproj ) USE uspp_param, ONLY : upf, nhm, nh USE wavefunctions_module, ONLY : evc USE becmod, ONLY : bec_type, becp, calbec - USE mp_global, ONLY : intra_pool_comm + USE mp_global, ONLY : intra_bgrp_comm USE mp, ONLY : mp_sum IMPLICIT NONE @@ -583,11 +581,11 @@ SUBROUTINE dprojdepsilon_gamma ( wfcatom, spsi, ipol, jpol, dproj ) wfatdbeta(iwf,ih) - wfcatom(1,iwf)*dbeta(1,jkb2) END DO END DO -#ifdef __MPI - CALL mp_sum( dbetapsi, intra_pool_comm ) - CALL mp_sum( wfatbeta, intra_pool_comm ) - CALL mp_sum( wfatdbeta, intra_pool_comm ) -#endif + ! + CALL mp_sum( dbetapsi, intra_bgrp_comm ) + CALL mp_sum( wfatbeta, intra_bgrp_comm ) + CALL mp_sum( wfatdbeta, intra_bgrp_comm ) + ! DO ibnd = 1,nbnd DO ih=1,nh(nt) DO jh = 1,nh(nt) diff --git a/PW/src/summary.f90 b/PW/src/summary.f90 index 358a2d817..39602f341 100644 --- a/PW/src/summary.f90 +++ b/PW/src/summary.f90 @@ -45,7 +45,7 @@ SUBROUTINE summary() USE uspp_param, ONLY : upf USE wvfct, ONLY : nbnd, ecutwfc, qcutz, ecfixed, q2sigma USE lsda_mod, ONLY : nspin - USE mp_global, ONLY : intra_pool_comm + USE mp_global, ONLY : intra_bgrp_comm USE mp, ONLY : mp_sum #ifdef __ENVIRON USE environ_base, ONLY : do_environ @@ -339,7 +339,7 @@ SUBROUTINE summary() IF (doublegrid) THEN ! ngmtot = ngms - CALL mp_sum (ngmtot, intra_pool_comm) + CALL mp_sum (ngmtot, intra_bgrp_comm) ! WRITE( stdout, '(/5x,"Smooth grid: ",i8," G-vectors", 5x, & & "FFT dimensions: (",i4,",",i4,",",i4,")")') & diff --git a/PW/src/symme.f90 b/PW/src/symme.f90 index d8d856e99..5ca089470 100644 --- a/PW/src/symme.f90 +++ b/PW/src/symme.f90 @@ -464,7 +464,7 @@ CONTAINS ! ! Initialize arrays needed for parallel symmetrization ! - USE mp_global, ONLY : nproc_pool, me_pool, intra_pool_comm + USE mp_global, ONLY : nproc_bgrp, me_bgrp, intra_bgrp_comm USE parallel_include USE gvect, ONLY : ngm, gcutm, g, gg ! @@ -474,22 +474,22 @@ CONTAINS REAL(DP), ALLOCATABLE :: gcut_(:), g_(:,:) INTEGER :: np, ig, ngloc, ngpos, ierr, ngm_ ! - ALLOCATE ( sendcnt(nproc_pool), recvcnt(nproc_pool), & - sdispls(nproc_pool), rdispls(nproc_pool) ) - ALLOCATE ( gcut_(nproc_pool) ) + ALLOCATE ( sendcnt(nproc_bgrp), recvcnt(nproc_bgrp), & + sdispls(nproc_bgrp), rdispls(nproc_bgrp) ) + ALLOCATE ( gcut_(nproc_bgrp) ) ! ! the gcut_ cutoffs are estimated in such a way that there is an similar ! number of G-vectors in each shell gcut_(i) < G^2 < gcut_(i+1) ! - DO np = 1, nproc_pool - gcut_(np) = gcutm * np**twothirds/nproc_pool**twothirds + DO np = 1, nproc_bgrp + gcut_(np) = gcutm * np**twothirds/nproc_bgrp**twothirds END DO ! ! find the number of G-vectors in each shell (defined as above) ! beware: will work only if G-vectors are in order of increasing |G| ! ngpos=0 - DO np = 1, nproc_pool + DO np = 1, nproc_bgrp sdispls(np) = ngpos ngloc=0 DO ig=ngpos+1,ngm @@ -513,10 +513,10 @@ CONTAINS ! we need the number and positions of G-vector shells for other processors ! CALL mpi_alltoall( sendcnt, 1, MPI_INTEGER, recvcnt, 1, MPI_INTEGER, & - intra_pool_comm, ierr) + intra_bgrp_comm, ierr) ! rdispls(1) = 0 - DO np = 2, nproc_pool + DO np = 2, nproc_bgrp rdispls(np) = rdispls(np-1)+ recvcnt(np-1) END DO ! @@ -534,7 +534,7 @@ CONTAINS rdispls(:) = 3*rdispls(:) CALL mpi_alltoallv ( g , sendcnt, sdispls, MPI_DOUBLE_PRECISION, & g_, recvcnt, rdispls, MPI_DOUBLE_PRECISION, & - intra_pool_comm, ierr) + intra_bgrp_comm, ierr) sendcnt(:) = sendcnt(:)/3 recvcnt(:) = recvcnt(:)/3 sdispls(:) = sdispls(:)/3 @@ -556,7 +556,7 @@ CONTAINS ! Initialize G-vector shells needed for symmetrization ! USE constants, ONLY : eps8 - USE mp_global, ONLY : nproc_pool + USE mp_global, ONLY : nproc_bgrp IMPLICIT NONE ! INTEGER, INTENT(IN) :: ngm_ @@ -589,7 +589,7 @@ CONTAINS ! g vectors are not ordered in increasing order. This happens ! in the parallel case. ! - IF (nproc_pool > 1 .AND. ngm_ > 20000) THEN + IF (nproc_bgrp > 1 .AND. ngm_ > 20000) THEN ALLOCATE ( g2sort_g(ngm_)) g2sort_g(:)=g_(1,:)*g_(1,:)+g_(2,:)*g_(2,:)+g_(3,:)*g_(3,:) igsort(1) = 0 @@ -670,7 +670,7 @@ gloop: DO jg=iig,ngm_ USE gvect, ONLY : ngm, g #ifdef __MPI USE parallel_include - USE mp_global, ONLY : nproc_pool, me_pool, intra_pool_comm + USE mp_global, ONLY : intra_bgrp_comm #endif ! IMPLICIT NONE @@ -697,7 +697,7 @@ gloop: DO jg=iig,ngm_ DO is=1,nspin CALL mpi_alltoallv (rhog (1,is) , sendcnt, sdispls, MPI_DOUBLE_COMPLEX,& rhog_(1,is), recvcnt, rdispls, MPI_DOUBLE_COMPLEX, & - intra_pool_comm, ierr) + intra_bgrp_comm, ierr) END DO ! remember that G-vectors have 3 components sendcnt(:) = 3*sendcnt(:) @@ -706,7 +706,7 @@ gloop: DO jg=iig,ngm_ rdispls(:) = 3*rdispls(:) CALL mpi_alltoallv ( g , sendcnt, sdispls, MPI_DOUBLE_PRECISION, & g_, recvcnt, rdispls, MPI_DOUBLE_PRECISION, & - intra_pool_comm, ierr) + intra_bgrp_comm, ierr) ! ! Now symmetrize ! @@ -723,7 +723,7 @@ gloop: DO jg=iig,ngm_ DO is = 1, nspin CALL mpi_alltoallv (rhog_(1,is), recvcnt, rdispls, MPI_DOUBLE_COMPLEX, & rhog (1,is), sendcnt, sdispls, MPI_DOUBLE_COMPLEX, & - intra_pool_comm, ierr) + intra_bgrp_comm, ierr) END DO DEALLOCATE ( rhog_ ) #endif