Commit f6a1e5e1 authored by marsamos's avatar marsamos

changed most of intra_pool_comm with intra_bgrp_comm

and related variables. Example01 working normconsrving
ultrasoft still some differences in pressure.



git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/[email protected] c92efa57-630b-4861-b058-cf58834340f0
parent 827ef275
......@@ -30,7 +30,7 @@ SUBROUTINE add_bfield (v,rho)
USE cell_base, ONLY : omega
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE mp_global, ONLY : intra_pool_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE noncollin_module, ONLY : bfield, lambda, i_cons, mcons, &
pointlist, factlist, noncolin
......@@ -121,7 +121,7 @@ SUBROUTINE add_bfield (v,rho)
m1(ipol) = m1(ipol) * omega / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
END DO
END IF
CALL mp_sum( m1, intra_pool_comm )
CALL mp_sum( m1, intra_bgrp_comm )
IF (i_cons==3) THEN
IF (npol==1) THEN
......
......@@ -54,7 +54,7 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag)
USE io_global, ONLY : stdout,ionode
USE control_flags, ONLY : mixing_beta
USE lsda_mod, ONLY : nspin
USE mp_global, ONLY : intra_image_comm, me_pool, intra_pool_comm
USE mp_global, ONLY : intra_image_comm, me_bgrp, intra_bgrp_comm
USE fft_base, ONLY : dfftp
USE mp, ONLY : mp_bcast, mp_sum
USE control_flags, ONLY : iverbosity
......@@ -228,7 +228,7 @@ SUBROUTINE add_efield(vpoten,etotefield,rho,iflag)
index0 = 0
#if defined (__MPI)
!
DO i = 1, me_pool
DO i = 1, me_bgrp
index0 = index0 + dfftp%nr1x*dfftp%nr2x*dfftp%npp(i)
END DO
!
......
......@@ -23,7 +23,7 @@ subroutine addusforce (forcenl)
USE scf, ONLY : v, vltot
USE uspp, ONLY : becsum, okvan
USE uspp_param, ONLY : upf, lmaxq, nh, nhm
USE mp_global, ONLY : intra_pool_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE control_flags, ONLY : gamma_only
USE fft_interfaces,ONLY : fwfft
......@@ -116,7 +116,7 @@ subroutine addusforce (forcenl)
enddo
#ifdef __MPI
call mp_sum ( ddeeq, intra_pool_comm )
call mp_sum ( ddeeq, intra_bgrp_comm )
#endif
! WRITE( stdout,'( "dmatrix atom ",i4)') na
! do ih = 1, nh(nt)
......
......@@ -37,7 +37,7 @@ subroutine atomic_rho (rhoa, nspina)
USE wavefunctions_module, ONLY : psic
USE noncollin_module, ONLY : angle1, angle2
USE uspp_param, ONLY : upf
USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : invfft
......@@ -159,15 +159,10 @@ subroutine atomic_rho (rhoa, nspina)
enddo
rhoneg = omega * rhoneg / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3)
rhoima = omega * rhoima / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3)
#ifdef __MPI
#ifdef __BANDS
!
call mp_sum( rhoneg, intra_bgrp_comm )
call mp_sum( rhoima, intra_bgrp_comm )
#else
call mp_sum( rhoneg, intra_pool_comm )
call mp_sum( rhoima, intra_pool_comm )
#endif
#endif
!
IF ( rhoima > 1.0d-4 ) THEN
WRITE( stdout,'(5x,"Check: imaginary charge or magnetization=",&
& f12.6," (component ",i1,") set to zero")') rhoima, is
......
......@@ -104,7 +104,7 @@ CONTAINS
! ... 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_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
IMPLICIT NONE
......@@ -149,11 +149,7 @@ CONTAINS
!
ENDIF
!
#ifdef __BANDS
CALL mp_sum( betapsi( :, 1:m ), intra_bgrp_comm )
#else
CALL mp_sum( betapsi( :, 1:m ), intra_pool_comm )
#endif
!
CALL stop_clock( 'calbec' )
!
......@@ -168,7 +164,7 @@ CONTAINS
! ... matrix times matrix with summation index (k=1,npw) running on
! ... G-vectors or PWs : betapsi(i,j) = \sum_k beta^*(i,k) psi(k,j)
!
USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
IMPLICIT NONE
......@@ -210,11 +206,7 @@ CONTAINS
!
ENDIF
!
#ifdef __BANDS
CALL mp_sum( betapsi( :, 1:m ), intra_bgrp_comm )
#else
CALL mp_sum( betapsi( :, 1:m ), intra_pool_comm )
#endif
!
CALL stop_clock( 'calbec' )
!
......@@ -231,7 +223,7 @@ CONTAINS
! ... betapsi(i,1,j) = \sum_k=1,npw beta^*(i,k) psi(k,j)
! ... betapsi(i,2,j) = \sum_k=1,npw beta^*(i,k) psi(k+npwx,j)
!
USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
IMPLICIT NONE
......@@ -265,11 +257,7 @@ CONTAINS
CALL ZGEMM ('C', 'N', nkb, m*npol, npw, (1.0_DP, 0.0_DP), beta, &
npwx, psi, npwx, (0.0_DP, 0.0_DP), betapsi, nkb)
!
#ifdef __BANDS
CALL mp_sum( betapsi( :, :, 1:m ), intra_bgrp_comm )
#else
CALL mp_sum( betapsi( :, :, 1:m ), intra_pool_comm )
#endif
!
CALL stop_clock( 'calbec' )
!
......
......@@ -166,7 +166,7 @@ SUBROUTINE c_phase
USE wavefunctions_module, ONLY : evc
USE bp, ONLY : gdir, nppstr
USE becmod, ONLY : calbec
USE mp_global, ONLY : intra_pool_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
! --- Avoid implicit definitions ---
......@@ -543,9 +543,9 @@ SUBROUTINE c_phase
end if
end do
end do
#ifdef __MPI
call mp_sum( mat, intra_pool_comm )
#endif
!
call mp_sum( mat, intra_bgrp_comm )
!
DO nb=1,nbnd
DO mb=1,nbnd
! --- Calculate the augmented part: ij=KB projectors, ---
......
......@@ -186,7 +186,7 @@ SUBROUTINE diag_bands( iter, ik, avg_iter )
USE becmod, ONLY : bec_type, becp, calbec, &
allocate_bec_type, deallocate_bec_type
USE klist, ONLY : nks
USE mp_global, ONLY : nproc_pool
USE mp_global, ONLY : nproc_bgrp
!
IMPLICIT NONE
!
......@@ -215,7 +215,7 @@ SUBROUTINE diag_bands( iter, ik, avg_iter )
!
! ... allocate space for <beta_i|psi_j> - used in h_psi and s_psi
!
IF ( nbndx > npwx*nproc_pool ) &
IF ( nbndx > npwx*nproc_bgrp ) &
CALL errore ( 'diag_bands', 'too many bands, or too few plane waves',1)
!
CALL allocate_bec_type ( nkb, nbnd, becp )
......
......@@ -42,7 +42,7 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir)
USE fixed_occ
USE gvect, ONLY : ig_l2g
USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_pool_comm
USE mp_global, ONLY : intra_bgrp_comm
USE becmod, ONLY : calbec
! --- Avoid implicit definitions ---
IMPLICIT NONE
......@@ -445,7 +445,7 @@ SUBROUTINE c_phase_field(el_pola,ion_pola, fact_pola, pdir)
if(kpar /= (nppstr_3d(pdir)+1).or..not. l_para) then
mat(nb,mb) = zdotc(ngm,aux0,1,aux,1)
call mp_sum( mat(nb,mb), intra_pool_comm )
call mp_sum( mat(nb,mb), intra_bgrp_comm )
endif
! --- Calculate the augmented part: ij=KB projectors, ---
! --- R=atom index: SUM_{ijR} q(ijR) <u_nk|beta_iR> ---
......
......@@ -22,7 +22,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
USE constants, ONLY : pi
USE kinds, ONLY : DP
USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
!
IMPLICIT NONE
......@@ -117,11 +117,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
CALL ZGEMV( 'C', kdim, m, ONE, psi, kdmx, spsi, 1, ZERO, lagrange, 1 )
!
#ifdef __BANDS
CALL mp_sum( lagrange( 1:m ), intra_bgrp_comm )
#else
CALL mp_sum( lagrange( 1:m ), intra_pool_comm )
#endif
!
psi_norm = DBLE( lagrange(m) )
!
......@@ -148,11 +144,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
e(m) = ddot( kdim2, psi(1,m), 1, hpsi, 1 )
!
#ifdef __BANDS
CALL mp_sum( e(m), intra_bgrp_comm )
#else
CALL mp_sum( e(m), intra_pool_comm )
#endif
!
! ... start iteration for this band
!
......@@ -169,11 +161,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
es(1) = ddot( kdim2, spsi(1), 1, g(1), 1 )
es(2) = ddot( kdim2, spsi(1), 1, ppsi(1), 1 )
!
#ifdef __BANDS
CALL mp_sum( es , intra_bgrp_comm )
#else
CALL mp_sum( es , intra_pool_comm )
#endif
!
es(1) = es(1) / es(2)
!
......@@ -190,11 +178,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
CALL ZGEMV( 'C', kdim, ( m - 1 ), ONE, psi, &
kdmx, scg, 1, ZERO, lagrange, 1 )
!
#ifdef __BANDS
CALL mp_sum( lagrange( 1:m-1 ), intra_bgrp_comm )
#else
CALL mp_sum( lagrange( 1:m-1 ), intra_pool_comm )
#endif
!
DO j = 1, ( m - 1 )
!
......@@ -209,11 +193,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
gg1 = ddot( kdim2, g(1), 1, g0(1), 1 )
!
#ifdef __BANDS
CALL mp_sum( gg1, intra_bgrp_comm )
#else
CALL mp_sum( gg1 , intra_pool_comm )
#endif
!
END IF
!
......@@ -225,11 +205,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
gg = ddot( kdim2, g(1), 1, g0(1), 1 )
!
#ifdef __BANDS
CALL mp_sum( gg, intra_bgrp_comm )
#else
CALL mp_sum( gg , intra_pool_comm )
#endif
!
IF ( iter == 1 ) THEN
!
......@@ -269,11 +245,7 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
cg0 = ddot( kdim2, cg(1), 1, scg(1), 1 )
!
#ifdef __BANDS
CALL mp_sum( cg0 , intra_bgrp_comm )
#else
CALL mp_sum( cg0 , intra_pool_comm )
#endif
!
cg0 = SQRT( cg0 )
!
......@@ -287,19 +259,11 @@ SUBROUTINE ccgdiagg( npwx, npw, nbnd, npol, psi, e, btype, precondition, &
!
a0 = 2.D0 * ddot( kdim2, psi(1,m), 1, ppsi(1), 1 ) / cg0
!
#ifdef __BANDS
CALL mp_sum( a0 , intra_bgrp_comm )
#else
CALL mp_sum( a0 , intra_pool_comm )
#endif
!
b0 = ddot( kdim2, cg(1), 1, ppsi(1), 1 ) / cg0**2
!
#ifdef __BANDS
CALL mp_sum( b0 , intra_bgrp_comm )
#else
CALL mp_sum( b0 , intra_pool_comm )
#endif
!
e0 = e(m)
!
......
......@@ -14,8 +14,6 @@ SUBROUTINE cdiagh( n, h, ldh, e, v )
! ... hermitean matrix H. On output, the matrix is unchanged
!
USE kinds, ONLY : DP
USE mp_global, ONLY : nproc, npool, nproc_pool, me_pool, &
root_pool, intra_pool_comm
USE mp_global, ONLY : nproc, nbgrp, nproc_bgrp, me_bgrp, &
root_bgrp, intra_bgrp_comm
USE mp, ONLY : mp_bcast
......@@ -82,7 +80,6 @@ SUBROUTINE cdiagh( n, h, ldh, e, v )
!
! ... only the first processor diagonalize the matrix
!
#ifdef __BANDS
IF ( me_bgrp == root_bgrp ) THEN
!
CALL ZHPEV( 21, hp, e, v, ldh, n, aux, naux )
......@@ -91,17 +88,6 @@ SUBROUTINE cdiagh( n, h, ldh, e, v )
!
CALL mp_bcast( e, root_bgrp, intra_bgrp_comm )
CALL mp_bcast( v, root_bgrp, intra_bgrp_comm )
#else
IF ( me_pool == root_pool ) THEN
!
CALL ZHPEV( 21, hp, e, v, ldh, n, aux, naux )
!
END IF
!
CALL mp_bcast( e, root_pool, intra_pool_comm )
CALL mp_bcast( v, root_pool, intra_pool_comm )
#endif
!
DEALLOCATE( aux )
DEALLOCATE( hp )
......@@ -146,11 +132,7 @@ SUBROUTINE cdiagh( n, h, ldh, e, v )
!
! ... only the first processor diagonalize the matrix
!
#ifdef __BANDS
IF ( me_bgrp == root_bgrp ) THEN
#else
IF ( me_pool == root_pool ) THEN
#endif
!
! ... allocate workspace
!
......@@ -179,21 +161,11 @@ SUBROUTINE cdiagh( n, h, ldh, e, v )
#ifdef __PGI
! workaround for PGI compiler bug
!
#ifdef __BANDS
CALL mp_bcast( e(1:n), root_bgrp, intra_bgrp_comm )
CALL mp_bcast( v(1:ldh,1:n), root_bgrp, intra_bgrp_comm )
#else
CALL mp_bcast( e(1:n), root_pool, intra_pool_comm )
CALL mp_bcast( v(1:ldh,1:n), root_pool, intra_pool_comm )
#endif
#else
#ifdef __BANDS
CALL mp_bcast( e, root_bgrp, intra_bgrp_comm )
CALL mp_bcast( v, root_bgrp, intra_bgrp_comm )
#else
CALL mp_bcast( e, root_pool, intra_pool_comm )
CALL mp_bcast( v, root_pool, intra_pool_comm )
#endif
#endif
!
RETURN
......
......@@ -21,7 +21,6 @@ SUBROUTINE cdiaghg( n, m, h, s, ldh, e, v )
!
USE kinds, ONLY : DP
USE mp, ONLY : mp_bcast, mp_sum, mp_barrier, mp_max
USE mp_global, ONLY : me_pool, root_pool, intra_pool_comm
USE mp_global, ONLY : me_bgrp, root_bgrp, intra_bgrp_comm
!
IMPLICIT NONE
......@@ -56,11 +55,7 @@ SUBROUTINE cdiaghg( n, m, h, s, ldh, e, v )
!
! ... only the first processor diagonalizes the matrix
!
#ifdef __BANDS
IF ( me_bgrp == root_bgrp ) THEN
#else
IF ( me_pool == root_pool ) THEN
#endif
!
! ... save the diagonal of input S (it will be overwritten)
!
......@@ -179,13 +174,8 @@ SUBROUTINE cdiaghg( n, m, h, s, ldh, e, v )
!
! ... broadcast eigenvectors and eigenvalues to all other processors
!
#ifdef __BANDS
CALL mp_bcast( e, root_bgrp, intra_bgrp_comm )
CALL mp_bcast( v, root_bgrp, intra_bgrp_comm )
#else
CALL mp_bcast( e, root_pool, intra_pool_comm )
CALL mp_bcast( v, root_pool, intra_pool_comm )
#endif
!
CALL stop_clock( 'cdiaghg' )
!
......@@ -205,7 +195,6 @@ SUBROUTINE pcdiaghg( n, h, s, ldh, e, v, desc )
!
USE kinds, ONLY : DP
USE mp, ONLY : mp_bcast
USE mp_global, ONLY : root_pool, intra_pool_comm
USE mp_global, ONLY : root_bgrp, intra_bgrp_comm
USE zhpev_module, ONLY : pzhpev_drv, zhpev_drv
USE descriptors, ONLY : la_descriptor
......@@ -364,11 +353,7 @@ SUBROUTINE pcdiaghg( n, h, s, ldh, e, v, desc )
!
END IF
!
#ifdef __BANDS
CALL mp_bcast( e, root_bgrp, intra_bgrp_comm )
#else
CALL mp_bcast( e, root_pool, intra_pool_comm )
#endif
!
CALL stop_clock( 'cdiaghg:paragemm' )
!
......
......@@ -22,7 +22,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
! ... S is an overlap matrix, evc is a complex vector
!
USE kinds, ONLY : DP
USE mp_global, ONLY : intra_pool_comm, intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm
USE mp, ONLY : mp_sum
!
IMPLICIT NONE
......@@ -168,11 +168,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
CALL ZGEMM( 'C', 'N', nbase, nbase, kdim, ONE, &
psi, kdmx, hpsi, kdmx, ZERO, hc, nvecx )
!
#ifdef __BANDS
CALL mp_sum( hc( :, 1:nbase ), intra_bgrp_comm )
#else
CALL mp_sum( hc( :, 1:nbase ), intra_pool_comm )
#endif
!
IF ( uspp ) THEN
!
......@@ -186,11 +182,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
!
END IF
!
#ifdef __BANDS
CALL mp_sum( sc( :, 1:nbase ), intra_bgrp_comm )
#else
CALL mp_sum( sc( :, 1:nbase ), intra_pool_comm )
#endif
!
IF ( lrot ) THEN
!
......@@ -298,11 +290,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
!
END DO
!
#ifdef __BANDS
CALL mp_sum( ew( 1:notcnv ), intra_bgrp_comm )
#else
CALL mp_sum( ew( 1:notcnv ), intra_pool_comm )
#endif
!
DO n = 1, notcnv
!
......@@ -325,11 +313,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
CALL ZGEMM( 'C', 'N', nbase+notcnv, notcnv, kdim, ONE, psi, &
kdmx, hpsi(1,1,nb1), kdmx, ZERO, hc(1,nb1), nvecx )
!
#ifdef __BANDS
CALL mp_sum( hc( :, nb1:nb1+notcnv-1 ), intra_bgrp_comm )
#else
CALL mp_sum( hc( :, nb1:nb1+notcnv-1 ), intra_pool_comm )
#endif
!
IF ( uspp ) THEN
!
......@@ -343,11 +327,7 @@ SUBROUTINE cegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
!
END IF
!
#ifdef __BANDS
CALL mp_sum( sc( :, nb1:nb1+notcnv-1 ), intra_bgrp_comm )
#else
CALL mp_sum( sc( :, nb1:nb1+notcnv-1 ), intra_pool_comm )
#endif
!
CALL stop_clock( 'cegterg:overlap' )
!
......@@ -501,8 +481,7 @@ SUBROUTINE pcegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE mp_global, ONLY : npool, nproc_pool, me_pool, root_pool, &
intra_pool_comm, nbgrp, nproc_bgrp, me_bgrp, &
USE mp_global, ONLY : nbgrp, nproc_bgrp, me_bgrp, &
intra_bgrp_comm, root_bgrp, &
ortho_comm, np_ortho, me_ortho, ortho_comm_id, &
leg_ortho
......@@ -780,11 +759,7 @@ SUBROUTINE pcegterg( npw, npwx, nvec, nvecx, npol, evc, ethr, &
!
END DO
!
#ifdef __BANDS
CALL mp_sum( ew( 1:notcnv ), intra_bgrp_comm )
#else
CALL mp_sum( ew( 1:notcnv ), intra_pool_comm )
#endif
!
DO n = 1, notcnv
!
......@@ -1111,11 +1086,7 @@ CONTAINS
vtmp(:,1:notcl) = vl(:,1:notcl)
END IF
#ifdef __BANDS
CALL mp_bcast( vtmp(:,1:notcl), root, intra_bgrp_comm )
#else
CALL mp_bcast( vtmp(:,1:notcl), root, intra_pool_comm )
#endif
!
IF ( uspp ) THEN
!
......@@ -1184,22 +1155,14 @@ CONTAINS
!
! this proc sends his block
!
#ifdef __BANDS
CALL mp_bcast( vl(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vl(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
psi(1,1,ir), kdmx, vl, nx, beta, evc(1,1,ic), kdmx )
ELSE
!
! all other procs receive
!
#ifdef __BANDS
CALL mp_bcast( vtmp(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vtmp(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
psi(1,1,ir), kdmx, vtmp, nx, beta, evc(1,1,ic), kdmx )
END IF
......@@ -1250,22 +1213,14 @@ CONTAINS
!
! this proc sends his block
!
#ifdef __BANDS
CALL mp_bcast( vl(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vl(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
spsi(1,1,ir), kdmx, vl, nx, beta, psi(1,1,nvec+ic), kdmx )
ELSE
!
! all other procs receive
!
#ifdef __BANDS
CALL mp_bcast( vtmp(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vtmp(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
spsi(1,1,ir), kdmx, vtmp, nx, beta, psi(1,1,nvec+ic), kdmx )
END IF
......@@ -1318,22 +1273,14 @@ CONTAINS
!
! this proc sends his block
!
#ifdef __BANDS
CALL mp_bcast( vl(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vl(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
hpsi(1,1,ir), kdmx, vl, nx, beta, psi(1,1,nvec+ic), kdmx )
ELSE
!
! all other procs receive
!
#ifdef __BANDS
CALL mp_bcast( vtmp(:,1:nc), root, intra_bgrp_comm )
#else
CALL mp_bcast( vtmp(:,1:nc), root, intra_pool_comm )
#endif
CALL ZGEMM( 'N', 'N', kdim, nc, nr, ONE, &
hpsi(1,1,ir), kdmx, vtmp, nx, beta, psi(1,1,nvec+ic), kdmx )
END IF
......@@ -1393,11 +1340,7 @@ CONTAINS
! accumulate result on dm of root proc.
#ifdef __BANDS
CALL mp_root_sum( work, dm, root, intra_bgrp_comm )
#else
CALL mp_root_sum( work, dm, root, intra_pool_comm )
#endif
END DO
!
......@@ -1452,17 +1395,9 @@ CONTAINS
kdmx, w(1,1,ii), kdmx, ZERO, vtmp, nx )
!
IF( (desc%active_node > 0) .AND. (ipr-1 == desc%myr) .AND. (ipc-1 == desc%myc) ) THEN
#ifdef __BANDS
CALL mp_root_sum( vtmp(:,1:nc), dm(:,icc:icc+nc-1), root, intra_bgrp_comm )
#else
CALL mp_root_sum( vtmp(:,1:nc), dm(:,icc:icc+nc-1), root, intra_pool_comm )
#endif
ELSE
#ifdef __BANDS
CALL mp_root_sum( vtmp(:,1:nc), dm, root, intra_bgrp_comm )
#else
CALL mp_root_sum( vtmp(:,1:nc), dm, root, intra_pool_comm )
#endif
END IF
END DO
......@@ -1489,11 +1424,7 @@ CONTAINS
e( i + ic - 1 ) = REAL( hl( i, i ) )
END DO
END IF
#ifdef __BANDS