scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

- further becp data distribution (for gamma point calculation) 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@8733 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
ccavazzoni 2012-02-26 21:59:38 +00:00
parent 5e525b1ea3
commit cbd3088c20
7 changed files with 102 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
PW/src/add_vuspsi.f90
View File

@ -69,7 +69,7 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
SUBROUTINE add_vuspsi_gamma()
!-----------------------------------------------------------------------
!
USE mp, ONLY: mp_size, mp_rank, mp_get_comm_null, mp_circular_shift_left
USE mp, ONLY: mp_get_comm_null, mp_circular_shift_left
!
IMPLICIT NONE
INTEGER, EXTERNAL :: ldim_block, lind_block, gind_block
@ -86,12 +86,11 @@ SUBROUTINE add_vuspsi( lda, n, m, hpsi )
mype = 0
!
IF( becp%comm /= mp_get_comm_null() ) THEN
nproc = mp_size( becp%comm )
mype = mp_rank( becp%comm )
m_loc = ldim_block( becp%nbnd , nproc, mype )
m_begin = gind_block( 1, becp%nbnd, nproc, mype )
m_max = becp%nbnd / nproc
IF( MOD( becp%nbnd, nproc ) /= 0 ) m_max = m_max + 1
nproc = becp%nproc
mype = becp%mype
m_loc = becp%nbnd_loc
m_begin = becp%ibnd_begin
m_max = SIZE( becp%r, 2 )
IF( ( m_begin + m_loc - 1 ) > m ) m_loc = m - m_begin + 1
END IF
!

90
PW/src/becmod.f90
View File

@ -36,6 +36,10 @@ MODULE becmod
COMPLEX(DP),ALLOCATABLE :: nc(:,:,:) ! appropriate for noncolin
INTEGER :: comm
INTEGER :: nbnd
INTEGER :: nproc
INTEGER :: mype
INTEGER :: nbnd_loc
INTEGER :: ibnd_begin
END TYPE bec_type
#endif
!
@ -51,7 +55,7 @@ MODULE becmod
!
INTERFACE calbec
!
MODULE PROCEDURE calbec_k, calbec_gamma, calbec_nc, calbec_bec_type
MODULE PROCEDURE calbec_k, calbec_gamma, calbec_gamma_nocomm, calbec_nc, calbec_bec_type
!
END INTERFACE
@ -68,7 +72,8 @@ CONTAINS
!-----------------------------------------------------------------------
SUBROUTINE calbec_bec_type ( npw, beta, psi, betapsi, nbnd )
!-----------------------------------------------------------------------
!
!_
USE mp_global, ONLY: intra_bgrp_comm
USE mp, ONLY: mp_size, mp_rank, mp_get_comm_null
!
IMPLICIT NONE
@ -94,27 +99,19 @@ CONTAINS
!
IF( betapsi%comm == mp_get_comm_null() ) THEN
!
CALL calbec_gamma ( npw, beta, psi, betapsi%r, local_nbnd )
CALL calbec_gamma ( npw, beta, psi, betapsi%r, local_nbnd, intra_bgrp_comm )
!
ELSE
nproc = mp_size( betapsi%comm )
mype = mp_rank( betapsi%comm )
m_max = betapsi%nbnd / nproc
IF( MOD( betapsi%nbnd, nproc ) /= 0 ) m_max = m_max + 1
m_loc = ldim_block( betapsi%nbnd , nproc, mype )
m_begin = gind_block( 1, betapsi%nbnd, nproc, mype )
IF( ( m_begin + m_loc - 1 ) > local_nbnd ) m_loc = local_nbnd - m_begin + 1
!
ALLOCATE( dtmp( SIZE( betapsi%r, 1 ), m_max ) )
ALLOCATE( dtmp( SIZE( betapsi%r, 1 ), SIZE( betapsi%r, 2 ) ) )
!
DO ip = 0, nproc - 1
m_loc = ldim_block( betapsi%nbnd , nproc, ip )
m_begin = gind_block( 1, betapsi%nbnd, nproc, ip )
DO ip = 0, betapsi%nproc - 1
m_loc = ldim_block( betapsi%nbnd , betapsi%nproc, ip )
m_begin = gind_block( 1, betapsi%nbnd, betapsi%nproc, ip )
IF( ( m_begin + m_loc - 1 ) > local_nbnd ) m_loc = local_nbnd - m_begin + 1
IF( m_loc > 0 ) THEN
CALL calbec_gamma ( npw, beta, psi(:,m_begin:m_begin+m_loc-1), dtmp, m_loc )
IF( ip == mype ) THEN
CALL calbec_gamma ( npw, beta, psi(:,m_begin:m_begin+m_loc-1), dtmp, m_loc, betapsi%comm )
IF( ip == betapsi%mype ) THEN
betapsi%r(:,1:m_loc) = dtmp(:,1:m_loc)
END IF
END IF
@ -138,24 +135,45 @@ CONTAINS
!
END SUBROUTINE calbec_bec_type
!-----------------------------------------------------------------------
SUBROUTINE calbec_gamma ( npw, beta, psi, betapsi, nbnd )
SUBROUTINE calbec_gamma_nocomm ( npw, beta, psi, betapsi, nbnd )
!-----------------------------------------------------------------------
USE mp_global, ONLY: intra_bgrp_comm
IMPLICIT NONE
COMPLEX (DP), INTENT (in) :: beta(:,:), psi(:,:)
REAL (DP), INTENT (out) :: betapsi(:,:)
INTEGER, INTENT (in) :: npw
INTEGER, OPTIONAL :: nbnd
INTEGER :: m
IF ( present (nbnd) ) THEN
m = nbnd
ELSE
m = size ( psi, 2)
ENDIF
CALL calbec_gamma ( npw, beta, psi, betapsi, m, intra_bgrp_comm )
RETURN
!
END SUBROUTINE calbec_gamma_nocomm
!-----------------------------------------------------------------------
SUBROUTINE calbec_gamma ( npw, beta, psi, betapsi, nbnd, comm )
!-----------------------------------------------------------------------
!
! ... matrix times matrix with summation index (k=1,npw) running on
! ... half of the G-vectors or PWs - assuming k=0 is the G=0 component:
! ... betapsi(i,j) = 2Re(\sum_k beta^*(i,k)psi(k,j)) + beta^*(i,0)psi(0,j)
!
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
IMPLICIT NONE
COMPLEX (DP), INTENT (in) :: beta(:,:), psi(:,:)
REAL (DP), INTENT (out) :: betapsi(:,:)
INTEGER, INTENT (in) :: npw
INTEGER, OPTIONAL :: nbnd
INTEGER, INTENT (in) :: nbnd
INTEGER, INTENT (in) :: comm
!
INTEGER :: nkb, npwx, m
!
m = nbnd
!
nkb = size (beta, 2)
IF ( nkb == 0 ) RETURN
!
@ -163,11 +181,6 @@ CONTAINS
npwx= size (beta, 1)
IF ( npwx /= size (psi, 1) ) CALL errore ('calbec', 'size mismatch', 1)
IF ( npwx < npw ) CALL errore ('calbec', 'size mismatch', 2)
IF ( present (nbnd) ) THEN
m = nbnd
ELSE
m = size ( psi, 2)
ENDIF
#ifdef DEBUG
WRITE (*,*) 'calbec gamma'
WRITE (*,*) nkb, size (betapsi,1) , m , size (betapsi, 2)
@ -190,7 +203,7 @@ CONTAINS
!
ENDIF
!
CALL mp_sum( betapsi( :, 1:m ), intra_bgrp_comm )
CALL mp_sum( betapsi( :, 1:m ), comm )
!
CALL stop_clock( 'calbec' )
!
@ -309,12 +322,13 @@ CONTAINS
!-----------------------------------------------------------------------
SUBROUTINE allocate_bec_type ( nkb, nbnd, bec, comm )
!-----------------------------------------------------------------------
USE mp, ONLY: mp_size, mp_get_comm_null
USE mp, ONLY: mp_size, mp_rank, mp_get_comm_null
IMPLICIT NONE
TYPE (bec_type) :: bec
INTEGER, INTENT (in) :: nkb, nbnd
INTEGER, INTENT (in), OPTIONAL :: comm
INTEGER :: ierr, nbnd_siz, nproc
INTEGER :: ierr, nbnd_siz
INTEGER, EXTERNAL :: ldim_block, lind_block, gind_block
!
#ifdef __STD_F95
NULLIFY(bec%r)
@ -325,16 +339,24 @@ CONTAINS
nbnd_siz = nbnd
bec%comm = mp_get_comm_null()
bec%nbnd = nbnd
bec%mype = 0
bec%nproc = 1
bec%nbnd_loc = nbnd
bec%ibnd_begin = 1
!
IF( PRESENT( comm ) ) THEN
#ifdef __SCALAPACK
IF( PRESENT( comm ) .AND. gamma_only ) THEN
bec%comm = comm
nproc = mp_size( comm )
IF( nproc > 1 ) THEN
nbnd_siz = nbnd / nproc
IF( MOD( nbnd, nproc ) /= 0 ) nbnd_siz = nbnd_siz + 1
bec%nproc = mp_size( comm )
IF( bec%nproc > 1 ) THEN
nbnd_siz = nbnd / bec%nproc
IF( MOD( nbnd, bec%nproc ) /= 0 ) nbnd_siz = nbnd_siz + 1
bec%mype = mp_rank( bec%comm )
bec%nbnd_loc = ldim_block( becp%nbnd , bec%nproc, bec%mype )
bec%ibnd_begin = gind_block( 1, becp%nbnd, bec%nproc, bec%mype )
END IF
END IF
!
#endif
IF ( gamma_only ) THEN
!
ALLOCATE( bec%r( nkb, nbnd_siz ), STAT=ierr )

4
PW/src/c_bands.f90
View File

@ -218,11 +218,7 @@ SUBROUTINE diag_bands( iter, ik, avg_iter )
IF ( nbndx > npwx*nproc_bgrp ) &
CALL errore ( 'diag_bands', 'too many bands, or too few plane waves',1)
!
#ifdef __SCALAPACK
CALL allocate_bec_type ( nkb, nbnd, becp, intra_bgrp_comm )
#else
CALL allocate_bec_type ( nkb, nbnd, becp )
#endif
!
IF ( gamma_only ) THEN
!

32
PW/src/force_us.f90
View File

@ -31,7 +31,7 @@ SUBROUTINE force_us( forcenl )
USE buffers, ONLY : get_buffer
USE becmod, ONLY : bec_type, becp, allocate_bec_type, deallocate_bec_type
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_sum
USE mp, ONLY : mp_sum, mp_get_comm_null
!
IMPLICIT NONE
!
@ -40,7 +40,7 @@ SUBROUTINE force_us( forcenl )
REAL(DP) :: forcenl(3,nat)
! output: the nonlocal contribution
!
CALL allocate_bec_type ( nkb, nbnd, becp )
CALL allocate_bec_type ( nkb, nbnd, becp, intra_bgrp_comm )
!
IF ( gamma_only ) THEN
!
@ -68,18 +68,20 @@ SUBROUTINE force_us( forcenl )
IMPLICIT NONE
!
REAL(DP) :: forcenl(3,nat)
REAL(DP), ALLOCATABLE :: rdbecp (:,:,:)
TYPE(bec_type) :: rdbecp (3)
! auxiliary variable, contains <dbeta|psi>
COMPLEX(DP), ALLOCATABLE :: vkb1(:,:)
! auxiliary variable contains g*|beta>
REAL(DP) :: ps
INTEGER :: ik, ipol, ibnd, ig, ih, jh, na, nt, ikb, jkb, ijkb0
INTEGER :: ik, ipol, ibnd, ibnd_loc, ig, ih, jh, na, nt, ikb, jkb, ijkb0
! counters
!
!
forcenl(:,:) = 0.D0
!
ALLOCATE( rdbecp( nkb, nbnd, 3 ) )
DO ipol = 1, 3
CALL allocate_bec_type ( nkb, nbnd, rdbecp(ipol), intra_bgrp_comm )
END DO
ALLOCATE( vkb1( npwx, nkb ) )
!
IF ( nks > 1 ) REWIND iunigk
@ -106,7 +108,7 @@ SUBROUTINE force_us( forcenl )
END DO
END DO
!
CALL calbec ( npw, vkb1, evc, rdbecp(:,:,ipol) )
CALL calbec ( npw, vkb1, evc, rdbecp(ipol) )
!
END DO
!
@ -116,13 +118,14 @@ SUBROUTINE force_us( forcenl )
IF ( ityp(na) == nt ) THEN
DO ih = 1, nh(nt)
ikb = ijkb0 + ih
DO ibnd = 1, nbnd
DO ibnd_loc = 1, becp%nbnd_loc
ibnd = ibnd_loc + becp%ibnd_begin - 1
ps = deeq(ih,ih,na,current_spin) - &
et(ibnd,ik) * qq(ih,ih,nt)
DO ipol = 1, 3
forcenl(ipol,na) = forcenl(ipol,na) - &
ps * wg(ibnd,ik) * 2.D0 * tpiba * &
rdbecp(ikb,ibnd,ipol) *becp%r(ikb,ibnd)
rdbecp(ipol)%r(ikb,ibnd_loc) *becp%r(ikb,ibnd_loc)
END DO
END DO
!
@ -134,14 +137,15 @@ SUBROUTINE force_us( forcenl )
!
DO jh = ( ih + 1 ), nh(nt)
jkb = ijkb0 + jh
DO ibnd = 1, nbnd
DO ibnd_loc = 1, becp%nbnd_loc
ibnd = ibnd_loc + becp%ibnd_begin - 1
ps = deeq(ih,jh,na,current_spin) - &
et(ibnd,ik) * qq(ih,jh,nt)
DO ipol = 1, 3
forcenl(ipol,na) = forcenl(ipol,na) - &
ps * wg(ibnd,ik) * 2.d0 * tpiba * &
(rdbecp(ikb,ibnd,ipol) *becp%r(jkb,ibnd) + &
rdbecp(jkb,ibnd,ipol) *becp%r(ikb,ibnd) )
(rdbecp(ipol)%r(ikb,ibnd_loc) *becp%r(jkb,ibnd_loc) + &
rdbecp(ipol)%r(jkb,ibnd_loc) *becp%r(ikb,ibnd_loc) )
END DO
END DO
END DO
@ -153,6 +157,8 @@ SUBROUTINE force_us( forcenl )
END DO
END DO
!
IF( becp%comm /= mp_get_comm_null() ) CALL mp_sum( forcenl, becp%comm )
!
! ... The total D matrix depends on the ionic position via the
! ... augmentation part \int V_eff Q dr, the term deriving from the
! ... derivative of Q is added in the routine addusforce
@ -170,7 +176,9 @@ SUBROUTINE force_us( forcenl )
CALL symvector ( nat, forcenl )
!
DEALLOCATE( vkb1 )
DEALLOCATE(rdbecp )
DO ipol = 1, 3
CALL deallocate_bec_type ( rdbecp(ipol) )
END DO
!
RETURN
!

14
PW/src/s_psi.f90
View File

@ -94,7 +94,7 @@ SUBROUTINE s_psi( lda, n, m, psi, spsi )
! ... gamma version
!
USE becmod, ONLY : bec_type, becp
USE mp, ONLY: mp_size, mp_rank, mp_get_comm_null, mp_circular_shift_left
USE mp, ONLY: mp_get_comm_null, mp_circular_shift_left
!
IMPLICIT NONE
!
@ -116,12 +116,11 @@ SUBROUTINE s_psi( lda, n, m, psi, spsi )
mype = 0
!
IF( becp%comm /= mp_get_comm_null() ) THEN
nproc = mp_size( becp%comm )
mype = mp_rank( becp%comm )
m_loc = ldim_block( becp%nbnd , nproc, mype )
m_begin = gind_block( 1, becp%nbnd, nproc, mype )
m_max = becp%nbnd / nproc
IF( MOD( becp%nbnd, nproc ) /= 0 ) m_max = m_max + 1
nproc = becp%nproc
mype = becp%mype
m_loc = becp%nbnd_loc
m_begin = becp%ibnd_begin
m_max = SIZE(becp%r,2)
IF( ( m_begin + m_loc - 1 ) > m ) m_loc = m - m_begin + 1
END IF
!
@ -137,7 +136,6 @@ SUBROUTINE s_psi( lda, n, m, psi, spsi )
DO na = 1, nat
IF ( ityp(na) == nt ) THEN
DO ibnd_loc = 1, m_loc
ibnd = ibnd_loc + m_begin - 1
DO jh = 1, nh(nt)
jkb = ijkb0 + jh
DO ih = 1, nh(nt)

18
PW/src/sum_band.f90
View File

@ -37,7 +37,7 @@ SUBROUTINE sum_band()
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE spin_orb, ONLY : lspinorb, domag, fcoef
USE wvfct, ONLY : nbnd, npwx, npw, igk, wg, et, btype
USE mp_global, ONLY : inter_pool_comm
USE mp_global, ONLY : inter_pool_comm, intra_bgrp_comm
USE mp, ONLY : mp_bcast, mp_sum
USE funct, ONLY : dft_is_meta
USE paw_symmetry, ONLY : PAW_symmetrize
@ -112,7 +112,7 @@ SUBROUTINE sum_band()
ENDIF
ENDIF
!
IF ( okvan.OR.one_atom_occupations ) CALL allocate_bec_type (nkb,nbnd, becp)
IF ( okvan.OR.one_atom_occupations ) CALL allocate_bec_type (nkb,nbnd, becp,intra_bgrp_comm)
!
! ... specific routines are called to sum for each k point the contribution
! ... of the wavefunctions to the charge
@ -235,7 +235,7 @@ SUBROUTINE sum_band()
!
USE becmod, ONLY : bec_type, becp, calbec
USE mp_global, ONLY : me_pool
USE mp, ONLY : mp_sum
USE mp, ONLY : mp_sum, mp_get_comm_null
!
IMPLICIT NONE
!
@ -243,7 +243,7 @@ SUBROUTINE sum_band()
!
REAL(DP) :: w1, w2
! weights
INTEGER :: idx, ioff, incr, v_siz, j
INTEGER :: idx, ioff, incr, v_siz, j, ibnd_loc
COMPLEX(DP), ALLOCATABLE :: tg_psi(:)
REAL(DP), ALLOCATABLE :: tg_rho(:)
LOGICAL :: use_tg
@ -480,7 +480,9 @@ SUBROUTINE sum_band()
!
CALL start_clock( 'sum_band:becsum' )
!
DO ibnd = 1, nbnd
DO ibnd_loc = 1, becp%nbnd_loc
!
ibnd = ibnd_loc + becp%ibnd_begin - 1
!
w1 = wg(ibnd,ik)
ijkb0 = 0
@ -501,7 +503,7 @@ SUBROUTINE sum_band()
!
becsum(ijh,na,current_spin) = &
becsum(ijh,na,current_spin) + &
w1 *becp%r(ikb,ibnd) *becp%r(ikb,ibnd)
w1 *becp%r(ikb,ibnd_loc) *becp%r(ikb,ibnd_loc)
!
ijh = ijh + 1
!
@ -511,7 +513,7 @@ SUBROUTINE sum_band()
!
becsum(ijh,na,current_spin) = &
becsum(ijh,na,current_spin) + &
w1 * 2.D0 *becp%r(ikb,ibnd) *becp%r(jkb,ibnd)
w1 * 2.D0 *becp%r(ikb,ibnd_loc) *becp%r(jkb,ibnd_loc)
!
ijh = ijh + 1
!
@ -543,6 +545,8 @@ SUBROUTINE sum_band()
!
END DO k_loop
!
IF( becp%comm /= mp_get_comm_null() ) call mp_sum( becsum, becp%comm )
!
IF( dffts%have_task_groups ) THEN
DEALLOCATE( tg_psi )
DEALLOCATE( tg_rho )

4
PW/src/wfcinit.f90
View File

@ -156,6 +156,8 @@ SUBROUTINE init_wfc ( ik )
USE noncollin_module, ONLY : npol
USE wavefunctions_module, ONLY : evc
USE random_numbers, ONLY : randy
USE mp_global, ONLY : intra_bgrp_comm
USE control_flags, ONLY : gamma_only
!
IMPLICIT NONE
!
@ -254,7 +256,7 @@ SUBROUTINE init_wfc ( ik )
!
! ... Allocate space for <beta|psi>
!
CALL allocate_bec_type ( nkb, n_starting_wfc, becp )
CALL allocate_bec_type ( nkb, n_starting_wfc, becp, intra_bgrp_comm )
!
! ... the following trick is for electric fields with Berry's phase:
! ... by setting lelfield = .false. one prevents the calculation of