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

- group communicator variable substituted with intra_image_comm, 

first step needed to parallelize neb over images also for CP.
  Next we need to add the right communicator to all communications
- subroutine reduce substituted everywhere with mp_sum
- mp_sum for array with 4dims added in mp.f90
- workaround for xlf compiler, it has problems compiling file with
  initialization of large array in the definition line,
  see Modules/input_parameters.f90 , initialization moved to
  Modules/read_cards.f90 .


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2946 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
cavazzon 2006-03-23 09:19:43 +00:00
parent a21dd7679e
commit dd93c6ad14
51 changed files with 362 additions and 837 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/brillouin.f90
View File

@ -12,7 +12,6 @@
!
!------------------------------------------------------------------------------!
USE kinds, ONLY : DP
USE mp, ONLY : mp_bcast
! ...
!
IMPLICIT NONE

12
CPV/cg_sub.f90
View File

@ -51,7 +51,7 @@
use smallbox_grid_dimensions, only: nnrb => nnrbx, nr1b, nr2b, nr3b
use local_pseudo, only: vps, rhops
use io_global, ONLY: io_global_start, stdout, ionode, ionode_id
use mp_global, ONLY: mp_global_start, group
use mp_global, ONLY: intra_image_comm
use dener
use derho
use cdvan
@ -73,7 +73,7 @@
berry_energy, ctabin, gqq, gqqm, df, pberryel, &
tefield2, evalue2, ctable2, qmat2, detq2, ipolp2, &
berry_energy2, ctabin2, gqq2, gqqm2, pberryel2
use mp, only: mp_sum,mp_bcast
use mp, only: mp_sum, mp_bcast
use cp_electronic_mass, ONLY : emass_cutoff
use orthogonalize_base, ONLY : calphi
use charge_density, ONLY : rhoofr
@ -378,7 +378,7 @@
endif
enddo
call mp_sum(gamma)
call mp_sum( gamma, intra_image_comm )
if (nvb.gt.0) then
do is=1,nvb
@ -412,7 +412,7 @@
enddo
enddo
call mp_sum(gamma)
call mp_sum( gamma, intra_image_comm )
if(nvb.gt.0) then
do iss=1,nspin
@ -508,7 +508,7 @@
enddo
endif
call mp_sum(dene0)
call mp_sum( dene0, intra_image_comm )
!if the derivative is positive, search along opposite direction
if(dene0.gt.0.d0) then
@ -836,7 +836,7 @@
!
end do
call mp_sum( lambda, group )
call mp_sum( lambda, intra_image_comm )
if(tens) then!in the ensemble case matrix labda must be multiplied with f
do is = 1, nspin

12
CPV/cglib.f90
View File

@ -184,6 +184,7 @@ subroutine pc2(a,beca,b,becb)
use ions_base, only: na, nsp
use io_global, only: stdout
use mp_global, only: intra_image_comm
use cvan
use gvecw, only: ngw
use constants, only: pi, fpi
@ -217,7 +218,7 @@ subroutine pc2(a,beca,b,becb)
sca=sca-DBLE(CONJG(a(1,j))*b(1,i))
endif
call mp_sum( sca )
call mp_sum( sca, intra_image_comm )
if (nvb.gt.0) then
@ -260,6 +261,7 @@ subroutine pc2(a,beca,b,becb)
use ions_base, only: na, nsp
use io_global, only: stdout
use mp_global, only: intra_image_comm
use cvan
use gvecw, only: ngw
use constants, only: pi, fpi
@ -291,7 +293,7 @@ subroutine pc2(a,beca,b,becb)
if (ng0.eq.2) then
sca=sca-DBLE(CONJG(a(1,j))*b(1,i))
endif
call mp_sum(sca)
call mp_sum( sca, intra_image_comm )
do ig=1,ngw
b(ig,i)=b(ig,i)-sca*as(ig,j)
enddo
@ -313,6 +315,7 @@ subroutine pc2(a,beca,b,becb)
use kinds, only: dp
use ions_base, only: na, nsp
use io_global, only: stdout
use mp_global, only: intra_image_comm
use cvan
use gvecw, only: ngw
use constants, only: pi, fpi
@ -386,7 +389,7 @@ subroutine pc2(a,beca,b,becb)
sca=sca-DBLE(CONJG(betae(1,inl))*betae(1,jnl))
endif
endif
call mp_sum(sca)
call mp_sum( sca, intra_image_comm )
m_minus1(inl,jnl)=sca
enddo
enddo
@ -432,6 +435,7 @@ subroutine pc2(a,beca,b,becb)
use kinds, only: dp
use ions_base, only: na, nsp
use io_global, only: stdout
use mp_global, only: intra_image_comm
use cvan
use uspp_param, only: nh
use uspp, only :nhsa=>nkb, nhsavb=>nkbus, qq
@ -477,7 +481,7 @@ subroutine pc2(a,beca,b,becb)
enddo
call mp_sum(beck)
call mp_sum( beck, intra_image_comm )
endif
!
!

15
CPV/chargedensity.f90
View File

@ -129,7 +129,7 @@
! ... declare modules
USE fft_base, ONLY: dfftp, dffts
USE mp_global, ONLY: mpime
USE mp_global, ONLY: mpime, intra_image_comm
USE mp, ONLY: mp_sum
USE turbo, ONLY: tturbo, nturbo, turbo_states, allocate_turbo
USE cell_module, ONLY: boxdimensions
@ -330,8 +330,8 @@
END DO
END DO
!
CALL mp_sum( rsumg( 1:nspin ) )
CALL mp_sum( rsumr( 1:nspin ) )
CALL mp_sum( rsumg( 1:nspin ), intra_image_comm )
CALL mp_sum( rsumr( 1:nspin ), intra_image_comm )
!
if ( nspin == 1 ) then
WRITE( stdout, 10) rsumg(1), rsumr(1)
@ -394,6 +394,7 @@
USE mp, ONLY: mp_sum
USE dener, ONLY: denl, dekin
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE funct, ONLY: dft_is_meta
USE cg_module, ONLY: tcg
USE cp_main_variables, ONLY: rhopr
@ -622,8 +623,8 @@
rsumg(iss)=0.0
END DO
END IF
CALL mp_sum( rsumg( 1:nspin ) )
CALL mp_sum( rsumr( 1:nspin ) )
CALL mp_sum( rsumg( 1:nspin ), intra_image_comm )
CALL mp_sum( rsumr( 1:nspin ), intra_image_comm )
IF ( nspin == 1 ) THEN
WRITE( stdout, 10) rsumg(1), rsumr(1)
@ -671,8 +672,8 @@
END DO
END IF
CALL mp_sum( rsumg( 1:nspin ) )
CALL mp_sum( rsumr( 1:nspin ) )
CALL mp_sum( rsumg( 1:nspin ), intra_image_comm )
CALL mp_sum( rsumr( 1:nspin ), intra_image_comm )
IF ( nspin == 1 ) THEN
WRITE( stdout, 10) rsumg(1), rsumr(1)

4
CPV/chargemix.f90
View File

@ -154,7 +154,7 @@
USE reciprocal_vectors, ONLY: gstart, gzero, g
USE gvecp, ONLY: ngm
USE wave_base, ONLY: scalw
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE io_global, ONLY: stdout
USE mp, ONLY: mp_sum
@ -336,7 +336,7 @@
DEALLOCATE(rho_old, STAT=ierr)
IF( ierr /= 0 ) CALL errore(' newrho ', ' deallocating rho_old ', ierr)
CALL mp_sum(drho, group)
CALL mp_sum(drho, intra_image_comm)
RETURN
END SUBROUTINE newrho

6
CPV/chi2.f90
View File

@ -39,7 +39,7 @@
USE cell_base, ONLY: tpiba
USE cell_module, only: boxdimensions
use mp, ONLY: mp_sum
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE io_files, ONLY: chiunit, chifile
USE reciprocal_vectors, ONLY: gstart, gx
USE gvecp, ONLY: ngm
@ -96,7 +96,7 @@
end do
END DO
CALL mp_sum(CHI,group)
CALL mp_sum(CHI,intra_image_comm)
!
CHI = CHI * OMEGA * CMPLX(0.0d0,1.0d0)
@ -122,7 +122,7 @@
END IF
CALL mp_sum( ierr, group )
CALL mp_sum( ierr, intra_image_comm )
IF( ierr > 0 ) &
CALL errore( ' printchi2 ', ' writing to file '//TRIM( chifile ), 1 )

15
CPV/cp_fpmd.f90
View File

@ -340,6 +340,7 @@ end subroutine ggenb
USE fft_base, ONLY: dfftp, dffts, fft_dlay_descriptor
use mp, ONLY: mp_sum, mp_max
use io_global, only: ionode
use mp_global, only: intra_image_comm
use constants, only: eps8
use control_flags, only: iprsta
!
@ -367,8 +368,8 @@ end subroutine ggenb
ng_g = ng
ngwt = ngw
CALL mp_sum( ng_g )
CALL mp_sum( ngwt )
CALL mp_sum( ng_g, intra_image_comm )
CALL mp_sum( ngwt, intra_image_comm )
!
! Temporary global and replicated arrays, used for sorting
@ -497,7 +498,7 @@ end subroutine ggenb
end if
ichk = gstart
CALL mp_max( ichk )
CALL mp_max( ichk, intra_image_comm )
IF( ichk /= 2 ) &
CALL errore( ' ggencp ', ' inconsistent value for gstart ', ichk )
!
@ -1573,7 +1574,7 @@ SUBROUTINE gmeshinfo( )
!
! Print out the number of g vectors for the different mesh
!
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE io_global, ONLY: ionode, ionode_id, stdout
USE mp, ONLY: mp_max, mp_gather
use gvecb, only: ngb
@ -1598,7 +1599,7 @@ SUBROUTINE gmeshinfo( )
ng_snd(1) = ng_g
ng_snd(2) = ng_l
ng_snd(3) = ng_lx
CALL mp_gather(ng_snd, ng_rcv, ionode_id, group)
CALL mp_gather(ng_snd, ng_rcv, ionode_id, intra_image_comm)
!
IF(ionode) THEN
WRITE( stdout,1000)
@ -1610,7 +1611,7 @@ SUBROUTINE gmeshinfo( )
ng_snd(1) = ngst
ng_snd(2) = ngs
ng_snd(3) = ngsx
CALL mp_gather(ng_snd, ng_rcv, ionode_id, group)
CALL mp_gather(ng_snd, ng_rcv, ionode_id, intra_image_comm)
!
IF(ionode) THEN
WRITE( stdout,1001)
@ -1622,7 +1623,7 @@ SUBROUTINE gmeshinfo( )
ng_snd(1) = ngw_g
ng_snd(2) = ngw_l
ng_snd(3) = ngw_lx
CALL mp_gather(ng_snd, ng_rcv, ionode_id, group)
CALL mp_gather(ng_snd, ng_rcv, ionode_id, intra_image_comm)
!
IF(ionode) THEN
WRITE( stdout,1002)

3
CPV/cp_restart.f90
View File

@ -41,6 +41,7 @@ MODULE cp_restart
!
USE control_flags, ONLY : gamma_only, force_pairing, reduce_io
USE io_files, ONLY : psfile, pseudo_dir
USE mp_global, ONLY : intra_image_comm
USE printout_base, ONLY : title
USE grid_dimensions, ONLY : nr1, nr2, nr3, nr1x, nr2x, nr3l
USE smooth_grid_dimensions, ONLY : nr1s, nr2s, nr3s
@ -222,7 +223,7 @@ MODULE cp_restart
!
mill(:,ig_l2g(1:ngm)) = mill_l(:,1:ngm)
!
CALL mp_sum( mill )
CALL mp_sum( mill, intra_image_comm )
!
lsda = ( nspin == 2 )
!

91
CPV/cplib.f90
View File

@ -101,6 +101,7 @@
USE uspp_param, ONLY: nh
USE uspp, ONLY: qq
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
USE kinds, ONLY: DP
!
IMPLICIT NONE
@ -121,7 +122,7 @@
rsum=2.*SUM(temp)
IF (gstart == 2) rsum=rsum-temp(1)
CALL mp_sum( rsum )
CALL mp_sum( rsum, intra_image_comm )
DEALLOCATE(temp)
!
@ -156,6 +157,7 @@
USE cell_base, ONLY: ainv, tpiba2
USE gvecw, ONLY: ggp, ecutz, ecsig, ecfix
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
!
IMPLICIT NONE
! input
@ -191,7 +193,7 @@
END DO
DEALLOCATE (gtmp)
CALL mp_sum( dekin( 1:3, 1:3 ) )
CALL mp_sum( dekin( 1:3, 1:3 ), intra_image_comm )
!
RETURN
END SUBROUTINE denkin
@ -218,6 +220,7 @@
USE cell_base, ONLY: ainv, tpiba2
USE local_pseudo, ONLY: rhops, drhops
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
IMPLICIT NONE
! input
@ -254,7 +257,7 @@
ENDDO
ENDDO
CALL mp_sum( dh( 1:3, 1:3 ) )
CALL mp_sum( dh( 1:3, 1:3 ), intra_image_comm )
DO i=1,3
DO j=1,3
@ -285,6 +288,7 @@
USE cell_base, ONLY: ainv, tpiba2
USE local_pseudo, ONLY: vps, dvps
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
IMPLICIT NONE
! input
@ -318,7 +322,7 @@
ENDDO
ENDDO
CALL mp_sum( dps( 1:3, 1:3 ) )
CALL mp_sum( dps( 1:3, 1:3 ), intra_image_comm )
RETURN
END SUBROUTINE denps
@ -338,6 +342,7 @@
USE recvecs_indexes, ONLY: np
USE cell_base, ONLY: omega, ainv, tpiba2
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
USE atom, ONLY: nlcc
USE grid_dimensions, ONLY: nr1, nr2, nr3, nr1x, nr2x, nr3x
USE fft_module, ONLY: fwfft
@ -394,7 +399,7 @@
dcc = dcc * omega
CALL mp_sum( dcc( 1:3, 1:3 ) )
CALL mp_sum( dcc( 1:3, 1:3 ), intra_image_comm )
RETURN
END SUBROUTINE denlcc
@ -591,6 +596,7 @@
USE uspp, ONLY: nhsa=>nkb, qq
USE uspp_param, ONLY: nh
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
!
IMPLICIT NONE
!
@ -619,7 +625,7 @@
IF (gstart == 2) csc(k)=csc(k)-DBLE(temp(1))
END DO
CALL mp_sum( csc( 1:kmax ) )
CALL mp_sum( csc( 1:kmax ), intra_image_comm )
DO k=1,kmax
rsum=0.
@ -901,7 +907,7 @@
USE reciprocal_vectors, ONLY: gstart
USE gvecw, ONLY: ggp
USE mp, ONLY: mp_sum
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE cell_base, ONLY: tpiba2
IMPLICIT NONE
@ -926,7 +932,7 @@
END DO
END DO
CALL mp_sum( sk(1:n), group )
CALL mp_sum( sk(1:n), intra_image_comm )
enkin=0.0
DO i=1,n
@ -1218,6 +1224,7 @@
USE electrons_base, ONLY: ispin
USE gvecw, ONLY: ngw
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
USE kinds, ONLY: DP
USE reciprocal_vectors, ONLY: gstart
!
@ -1249,7 +1256,7 @@
ENDIF
END DO
CALL mp_sum( csc( 1:kmax ) )
CALL mp_sum( csc( 1:kmax ), intra_image_comm )
!
! calculate bec(i)=<cp(i)|beta>
@ -1263,7 +1270,7 @@
IF (gstart == 2) bec(inl,i)= bec(inl,i)-temp(1)
END DO
CALL mp_sum( bec( 1:nhsavb, i ) )
CALL mp_sum( bec( 1:nhsavb, i ), intra_image_comm )
!
! calculate csc(k)=<cp(i)|S|cp(k)>, k<i
!
@ -1484,6 +1491,7 @@
USE electrons_base, ONLY: nspin
USE control_flags, ONLY: iprint, thdyn, tfor, tprnfor
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
USE fft_module, ONLY: invfft
USE fft_base, ONLY: dfftb
!
@ -1568,7 +1576,7 @@
END DO
END DO
CALL reduce(nat*nhm*nhm*nspin,deeq)
CALL mp_sum( deeq, intra_image_comm )
IF (.NOT.( tfor .OR. thdyn .OR. tprnfor ) ) go to 10
!
@ -1691,7 +1699,7 @@
END DO
END IF
CALL reduce(3*natx*nvb,fvan)
CALL mp_sum( fvan, intra_image_comm )
isa = 0
DO is = 1, nvb
@ -1880,6 +1888,8 @@
! Projection on atomic wavefunctions
!
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
USE electrons_base, ONLY: nx => nbspx, n => nbsp
USE gvecw, ONLY: ngw
USE reciprocal_vectors, ONLY: gstart
@ -1932,7 +1942,7 @@
CALL MXMA(wfc,2*ngw,1,swfc,1,2*ngw,overlap,1, &
& n_atomic_wfc,n_atomic_wfc,2*ngw,n_atomic_wfc)
CALL reduce(n_atomic_wfc**2,overlap)
CALL mp_sum( overlap, intra_image_comm )
overlap=overlap*2.d0
IF (gstart == 2) THEN
@ -1985,7 +1995,7 @@
END DO
DEALLOCATE(temp)
CALL reduce(n*n_atomic_wfc,proj)
CALL mp_sum( proj, intra_image_comm )
i=0
WRITE( stdout,'(/''Projection on atomic states:'')')
@ -2097,6 +2107,8 @@
USE kinds, ONLY: dp
USE ions_base, ONLY: nas => nax, nat, na, nsp
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
USE cvan, ONLY: nvb
USE uspp_param, ONLY: nh, nhm
USE uspp, ONLY: deeq
@ -2236,7 +2248,7 @@
IF(iprsta.GT.2) THEN
ca = SUM(v)
CALL reduce(2,ca)
CALL mp_sum( ca, intra_image_comm )
WRITE( stdout,'(a,2f12.8)') &
& ' rhov: int n_v(r) dr = ',omega*ca/(nr1*nr2*nr3)
@ -2327,7 +2339,7 @@
!
IF(iprsta.GT.2) THEN
ca = SUM(v)
CALL reduce(2,ca)
CALL mp_sum( ca, intra_image_comm )
WRITE( stdout,'(a,2f12.8)') 'rhov:in n_v ',omega*ca/(nr1*nr2*nr3)
ENDIF
!
@ -2453,6 +2465,8 @@
!
USE electrons_base, ONLY: nx => nbspx, n => nbsp, iupdwn, nupdwn, f, nel, nspin
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
USE gvecw, ONLY: ngw
USE reciprocal_vectors, ONLY: gstart
USE grid_dimensions, ONLY: nr1, nr2, nr3, &
@ -2507,7 +2521,7 @@
DO ir=1,nnr
spin1 = spin1 - MIN(rhor(ir,1),rhor(ir,2))
END DO
CALL reduce(1,spin1)
CALL mp_sum( spin1, intra_image_comm )
spin1 = spin0 + omega/(nr1*nr2*nr3)*spin1
IF (frac) THEN
WRITE( stdout,'(/'' Spin contamination: s(s+1)='',f5.2,'' (Becke) '',&
@ -2532,7 +2546,7 @@
END DO
END DO
DEALLOCATE (temp)
CALL reduce(nup*ndw,overlap)
CALL mp_sum( overlap, intra_image_comm )
DO j=1,ndw
jj=j+iupdwn(2)-1
DO i=1,nup
@ -2612,7 +2626,7 @@
USE dener
USE derho
USE mp, ONLY: mp_sum
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE funct, ONLY: dft_is_meta
USE fft_module, ONLY: fwfft, invfft
USE sic_module, ONLY: self_interaction, sic_epsilon, sic_alpha
@ -2714,7 +2728,7 @@
epseu=wz*DBLE(SUM(vtemp))
IF (gstart == 2) epseu=epseu-vtemp(1)
CALL mp_sum( epseu, group )
CALL mp_sum( epseu, intra_image_comm )
epseu=epseu*omega
!
IF(tpre) CALL denps(rhotmp,drhotmp,sfac,vtemp,dps)
@ -2753,11 +2767,11 @@
self_ehte = sic_epsilon * self_ehtet * wz * 0.5d0
eh = eh - self_ehte
CALL mp_sum( self_ehte, group )
CALL mp_sum( self_ehte, intra_image_comm )
ENDIF
!
CALL mp_sum( eh, group )
CALL mp_sum( eh, intra_image_comm )
!
IF(tpre) CALL denh(rhotmp,drhotmp,sfac,vtemp,eh,dh)
IF(tpre) DEALLOCATE(drhotmp)
@ -2842,7 +2856,7 @@
IF ( nlcc_any ) CALL force_cc( irb, eigrb, rhor, fion1 )
CALL mp_sum( fion1 )
CALL mp_sum( fion1, intra_image_comm )
!
! add g-space ionic and core correction contributions to fion
!
@ -2894,7 +2908,7 @@
& /2.0/DBLE(nr1*nr2*nr3)
ENDIF
CALL mp_sum( vave, group )
CALL mp_sum( vave, intra_image_comm )
!
! fourier transform of total potential to r-space (smooth grid)
@ -2988,28 +3002,33 @@
!
! check \int rho(r)dr and the negative part of rho
!
USE kinds, ONLY: DP
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
IMPLICIT NONE
INTEGER nnr, nspin
REAL(8) rhor(nnr,nspin), rmin, rmax, rsum, rnegsum
!
REAL(8) roe
REAL(DP) rhor(nnr,nspin), rmin, rmax, rsum, rnegsum
!
REAL(DP) roe
INTEGER ir, iss
!
rsum =0.0
rnegsum=0.0
rmin =100.
rmax =0.0
DO iss=1,nspin
DO ir=1,nnr
roe=rhor(ir,iss)
rsum=rsum+roe
IF (roe.LT.0.0) rnegsum=rnegsum+roe
rmax=MAX(rmax,roe)
rmin=MIN(rmin,roe)
DO iss = 1, nspin
DO ir = 1, nnr
roe = rhor(ir,iss)
rsum = rsum + roe
IF ( roe < 0.0 ) rnegsum = rnegsum + roe
rmax = MAX( rmax, roe )
rmin = MIN( rmin, roe )
END DO
END DO
CALL reduce(1,rsum)
CALL reduce(1,rnegsum)
CALL mp_sum( rsum, intra_image_comm )
CALL mp_sum( rnegsum, intra_image_comm )
RETURN
END SUBROUTINE checkrho
!______________________________________________________________________

3
CPV/cplib_meta.f90
View File

@ -272,6 +272,7 @@
use dener
use derho
use mp, ONLY : mp_sum
use mp_global, ONLY : intra_image_comm
use metagga, ONLY : kedtaur, kedtaug, kedtaus, dkedtaus
USE fft_module, ONLY: fwfft, invfft
!
@ -368,7 +369,7 @@
end do
end do
#ifdef PARA
call reduce(9,dkedxc)
call mp_sum( dkedxc, intra_image_comm )
#endif
do j=1,3
do i=1,3

1
CPV/cpr.f90
View File

@ -878,7 +878,6 @@ SUBROUTINE terminate_run()
CALL print_clock( 'fftw' )
CALL print_clock( 'fftb' )
CALL print_clock( 'rsg' )
CALL print_clock( 'reduce' )
!
1974 FORMAT( 1X,2I5,3F10.4,2X,3F10.4 )
1975 FORMAT( /1X,'Scaled coordinates '/1X,'species',' atom #' )

6
CPV/cpr_mod.f90
View File

@ -178,6 +178,7 @@ MODULE cpr_subroutines
!
subroutine elec_fakekine( ekincm, ema0bg, emass, c0, cm, ngw, n, delt )
use mp, only: mp_sum
use mp_global, only: intra_image_comm
use reciprocal_vectors, only: gstart
use wave_base, only: wave_speed2
real(8), intent(out) :: ekincm
@ -200,7 +201,7 @@ MODULE cpr_subroutines
end do
ekincm = ekincm * emass / ( delt * delt )
CALL mp_sum( ekincm )
CALL mp_sum( ekincm, intra_image_comm )
DEALLOCATE( emainv )
return
@ -208,6 +209,7 @@ MODULE cpr_subroutines
subroutine elec_fakekine2( ekincm, ema0bg, emass, c0, cm, ngw, n, delt )
use mp, only: mp_sum
use mp_global, only: intra_image_comm
use reciprocal_vectors, only: gstart
use wave_base, only: wave_speed2
real(8), intent(out) :: ekincm
@ -230,7 +232,7 @@ MODULE cpr_subroutines
end do
ekincm = ekincm * emass / ( delt * delt )
CALL mp_sum( ekincm )
CALL mp_sum( ekincm, intra_image_comm )
DEALLOCATE( emainv )
return

5
CPV/cprsub.f90
View File

@ -21,6 +21,7 @@ subroutine formf( tfirst, eself )
use mp, ONLY : mp_sum
use control_flags, ONLY : iprint, tpre, iprsta
use io_global, ONLY : stdout
use mp_global, ONLY : intra_image_comm
use bhs, ONLY : rc1, rc2, wrc2, wrc1, rcl, al, bl, lloc
use gvecs, ONLY : ngs
use cell_base, ONLY : omega, tpiba2, tpiba
@ -106,8 +107,8 @@ subroutine formf( tfirst, eself )
if( tfirst .or. ( iprsta >= 4 ) )then
vpsum = SUM( vps( 1:ngs, is ) )
rhopsum = SUM( rhops( 1:ngs, is ) )
call mp_sum( vpsum )
call mp_sum( rhopsum )
call mp_sum( vpsum, intra_image_comm )
call mp_sum( rhopsum, intra_image_comm )
WRITE( stdout,1250) vps(1,is),rhops(1,is)
WRITE( stdout,1300) vpsum,rhopsum
endif

16
CPV/diis.f90
View File

@ -174,7 +174,7 @@ CONTAINS
USE wave_base, ONLY: dotp
USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE io_global, ONLY: stdout
USE mp, ONLY: mp_max
IMPLICIT NONE
@ -204,7 +204,7 @@ CONTAINS
END IF
cnorm = cnorm + dotp( cdesc%gzero, ngw, c(:,i), c(:,i) )
END DO
CALL mp_max(gemax_l, group)
CALL mp_max(gemax_l, intra_image_comm)
gemax = gemax_l
cnorm = SQRT( cnorm / ( cdesc%nbt( 1 ) * cdesc%ngwt ) )
@ -227,7 +227,7 @@ CONTAINS
USE cell_base, ONLY: tpiba2
USE pseudopotential, ONLY: nspnl
USE ions_base, ONLY: nsp, na
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum, mp_max
USE reciprocal_vectors, ONLY: gstart, gzero, ggp
USE reciprocal_space_mesh, ONLY: gkmask_l, gkcutz_l
@ -260,7 +260,7 @@ CONTAINS
vp = vp + DBLE( sfac(1,i) ) * vps(1,i)
END DO
END IF
CALL mp_sum(vp, group)
CALL mp_sum(vp, intra_image_comm)
vpp = vp
@ -316,7 +316,7 @@ CONTAINS
! ... declare modules
USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE io_global, ONLY: stdout
USE mp, ONLY: mp_sum, mp_max
USE gvecw, ONLY: ngw
@ -477,7 +477,7 @@ CONTAINS
END DO
END DO
DO i=1,nsize-1
CALL mp_sum( bc(1:nsize,i), group)
CALL mp_sum( bc(1:nsize,i), intra_image_comm)
END DO
DO i=1,nsize-1
@ -587,7 +587,7 @@ CONTAINS
SUBROUTINE solve(b, ldb, ndim, v)
USE mp_global, ONLY: root, group
USE mp_global, ONLY: root, intra_image_comm
USE mp, ONLY: mp_bcast
!
IMPLICIT NONE
@ -619,7 +619,7 @@ CONTAINS
CALL errore(' solve ',' dsptrs has failed ', info)
END IF
CALL mp_bcast(v, root, group)
CALL mp_bcast(v, root, intra_image_comm)
RETURN
END SUBROUTINE solve

12
CPV/electrons.f90
View File

@ -310,7 +310,7 @@
SUBROUTINE rceigs( nei, gam, cgam, tortho, f, ei, gamma_symmetry )
USE mp, ONLY: mp_sum
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE energies, only: eig_total_energy
USE constants, only: au
@ -439,7 +439,7 @@
END IF
END IF
END DO
CALL mp_sum(ei,group)
CALL mp_sum(ei,intra_image_comm)
index(1) = 0
CALL hpsort(n, ei, index)
DEALLOCATE(index, STAT=ierr)
@ -499,7 +499,7 @@
SUBROUTINE cpackgam(cgam, f, caux)
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE mp, ONLY: mp_sum
IMPLICIT NONE
COMPLEX(DP), INTENT(INOUT) :: cgam(:,:)
@ -523,7 +523,7 @@
END DO
END DO
END IF
CALL mp_sum(caux, group)
CALL mp_sum(caux, intra_image_comm)
ELSE
IF( mpime < n ) THEN
DO i = 1, n
@ -541,7 +541,7 @@
! ----------------------------------------------
SUBROUTINE rpackgam(gam, f, aux)
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE mp, ONLY: mp_sum
IMPLICIT NONE
REAL(DP), INTENT(INOUT) :: gam(:,:)
@ -565,7 +565,7 @@
END DO
END DO
END IF
CALL mp_sum(aux, group)
CALL mp_sum(aux, intra_image_comm)
ELSE
IF( mpime < n ) THEN
DO i = 1, n

26
CPV/emptystates.f90
View File

@ -79,7 +79,7 @@
! ... This subroutine reads empty states from unit emptyunit
USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE io_global, ONLY: stdout
USE mp, ONLY: mp_bcast
USE mp_wave, ONLY: splitwf
@ -138,9 +138,9 @@
10 FORMAT('*** EMPTY STATES : wavefunctions dimensions changed ', &
/,'*** NGW = ', I8, ' NE1 = ', I4, ' NE2 = ', I4, ' NK = ', I4, ' NSPIN = ', I2)
CALL mp_bcast(exst, 0, group)
CALL mp_bcast(ne_rd, 0, group)
CALL mp_bcast(ngw_rd, 0, group)
CALL mp_bcast(exst, 0, intra_image_comm)
CALL mp_bcast(ne_rd, 0, intra_image_comm)
CALL mp_bcast(ngw_rd, 0, intra_image_comm)
IF (exst) THEN
@ -178,7 +178,7 @@
! ... This subroutine writes empty states to unit emptyunit
USE wave_types, ONLY: wave_descriptor
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE mp_wave, ONLY: mergewf
USE io_files, ONLY: scradir
USE reciprocal_vectors, ONLY: ig_l2g
@ -250,7 +250,7 @@
USE wave_types, ONLY: wave_descriptor
USE mp, ONLY: mp_sum
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
REAL(DP) SQRT, DNRM2
@ -287,7 +287,7 @@
CALL DAXPY( nf, -DBLE( ce(1,i) ), cf(1,1), 2*ngw, sf, 1 )
END IF
CALL DGEMV( 'T', 2*ngw, nf, 2.0d0, cf(1,1), ldw, ce(1,i), 1, 1.d0, sf, 1 )
CALL mp_sum( SF, group )
CALL mp_sum( SF, intra_image_comm )
temp = 0.0d0
CALL DGEMV( 'N', 2*ngw, nf, 1.d0, cf(1,1), ldw, sf, 1, 1.d0, TEMP, 1 )
IF(.NOT.TORTHO) THEN
@ -297,7 +297,7 @@
CALL DAXPY( i-1, -DBLE( ce(1,i) ), ce(1,1), 2*ngw, se, 1 )
END IF
CALL DGEMV( 'T', 2*ngw, i-1, 2.0d0, ce(1,1), ldw, ce(1,i), 1, 1.d0, se, 1 )
CALL mp_sum( SE, group )
CALL mp_sum( SE, intra_image_comm )
CALL DGEMV( 'N', 2*ngw, i-1, 1.d0, ce(1,1), ldw, se, 1, 1.d0, temp, 1 )
END IF
END IF
@ -310,7 +310,7 @@
ANORM = DNRM2(2*NGW,CE(1,I),1)
ANORM=2.D0*ANORM*ANORM
END IF
CALL mp_sum(ANORM,group)
CALL mp_sum(ANORM,intra_image_comm)
ANORM=SQRT(ANORM)
CALL DSCAL(2*NGW,1.0D0/ANORM,CE(1,I),1)
END IF
@ -325,7 +325,7 @@
csf = 0.0d0
CALL ZGEMV('C', ngw, nf, cone, cf(1,1), ldw, &
ce(1,i), 1, czero, csf(1), 1)
CALL mp_sum(csf, group)
CALL mp_sum(csf, intra_image_comm)
CALL ZGEMV('N', ngw, nf, cone, cf(1,1), ldw, &
csf(1), 1, czero, ctemp, 1)
IF( .NOT. TORTHO ) THEN
@ -333,7 +333,7 @@
IF( i .GT. 1 ) THEN
CALL ZGEMV('C', ngw, i-1, cone, ce(1,1), ldw, &
ce(1,i), 1, czero, cse(1), 1)
CALL mp_sum(cse, group)
CALL mp_sum(cse, intra_image_comm)
CALL ZGEMV('N', ngw, i-1, cone, ce(1,1), ldw, &
cse(1), 1, cone, ctemp, 1)
END IF
@ -344,7 +344,7 @@
do ig = 1, ngw
anorm = anorm + DBLE( ce(ig,i) * CONJG(ce(ig,i)) )
enddo
CALL mp_sum(anorm,group)
CALL mp_sum(anorm,intra_image_comm)
anorm = 1.0d0 / MAX( sqrt(anorm), 1.d-14 )
CALL ZDSCAL(NGW, anorm, CE(1,i), 1)
END IF
@ -433,7 +433,7 @@
USE orthogonalize, ONLY: ortho
USE nl, ONLY: nlsm1_s
USE mp, ONLY: mp_sum
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc
USE check_stop, ONLY: check_stop_now
USE atoms_type_module, ONLY: atoms_type
USE io_global, ONLY: ionode

9
CPV/exch_corr.f90
View File

@ -316,6 +316,7 @@
use mp, only : mp_sum
use metagga, ONLY : kedtaur
USE io_global, ONLY : stdout
USE mp_global, ONLY : intra_image_comm
use kinds, ONLY : DP
!
USE sic_module, ONLY : self_interaction, sic_alpha
@ -401,8 +402,8 @@
!
end if
call mp_sum( exc )
IF ( ttsic ) call mp_sum( self_exc )
call mp_sum( exc, intra_image_comm )
IF ( ttsic ) call mp_sum( self_exc, intra_image_comm )
exc = exc * omega / DBLE( nr1 * nr2 * nr3 )
IF ( ttsic ) self_exc = self_exc * omega/DBLE(nr1 * nr2 *nr3 )
@ -445,7 +446,7 @@
!
dxc = dxc * omega / ( nr1*nr2*nr3 )
!
call mp_sum ( dxc )
call mp_sum ( dxc, intra_image_comm )
!
do j=1,3
do i=1,3
@ -470,7 +471,7 @@
!
if (tpre) then
!
call mp_sum ( dexc )
call mp_sum ( dexc, intra_image_comm )
!
dxc = dxc + dexc
!

10
CPV/fftdrv.f90
View File

@ -62,7 +62,7 @@ CONTAINS
!
! based on code written by Stefano de Gironcoli for PWSCF
!
use mp_global, only: mpime, nproc, group
use mp_global, only: mpime, nproc, intra_image_comm
use fft_scalar, only: cft_1z, cft_2xy
!
implicit none
@ -141,9 +141,9 @@ CONTAINS
IF( iopt == 2 ) THEN
!
IF( what_scatter == 1 ) THEN
call fft_transpose ( aux, nr3, f, nr1x, nr2x, dfft, me, group, nproc, -2)
call fft_transpose ( aux, nr3, f, nr1x, nr2x, dfft, me, intra_image_comm, nproc, -2)
ELSE IF( what_scatter == 2 ) THEN
call fft_itranspose( aux, nr3, f, nr1x, nr2x, dfft, me, group, nproc, -2)
call fft_itranspose( aux, nr3, f, nr1x, nr2x, dfft, me, intra_image_comm, nproc, -2)
ELSE
if ( nproc == 1 ) then
nppx = dfft%nr3x
@ -198,9 +198,9 @@ CONTAINS
IF( iopt == -2 ) THEN
!
IF( what_scatter == 1 ) THEN
call fft_transpose ( aux, nr3, f, nr1x, nr2x, dfft, me, group, nproc, 2)
call fft_transpose ( aux, nr3, f, nr1x, nr2x, dfft, me, intra_image_comm, nproc, 2)
ELSE IF( what_scatter == 2 ) THEN
call fft_itranspose( aux, nr3, f, nr1x, nr2x, dfft, me, group, nproc, 2)
call fft_itranspose( aux, nr3, f, nr1x, nr2x, dfft, me, intra_image_comm, nproc, 2)
ELSE
if ( nproc == 1 ) then
nppx = dfft%nr3x

490
CPV/fromscra.f90
View File

@ -18,495 +18,11 @@ MODULE from_scratch_module
!
PUBLIC :: from_scratch
!
INTERFACE from_scratch
MODULE PROCEDURE from_scratch_fpmd, from_scratch_cp, from_scratch_all
END INTERFACE
!
CONTAINS
CONTAINS
!
!--------------------------------------------------------------------------
SUBROUTINE from_scratch_fpmd( rhor, cm, c0, cp, ce, cdesc, edesc, &
eigr, ei1, ei2, ei3, sfac, fi, ht, atoms, &
bec, becdr, vpot, edft )
!------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE wave_types, ONLY : wave_descriptor
USE wave_functions, ONLY : fixwave, wave_rand_init
USE wave_base, ONLY : wave_steepest
USE charge_density, ONLY : rhoofr
USE cell_module, only : boxdimensions
USE cell_base, ONLY : s_to_r
USE electrons_module, ONLY : nspin, pmss, occn_init, occn_info
USE ions_base, ONLY : taui, cdmi, randpos
USE mp, ONLY : mp_end
USE nl, ONLY : nlrh_m
USE energies, ONLY : dft_energy_type, debug_energies
USE potentials, ONLY : vofrhos
USE forces, ONLY : dforce_all
USE orthogonalize, ONLY : ortho
USE control_flags, ONLY : tcarpar, tfor, thdyn, tortho, tpre, tranp, &
force_pairing, iprsta, tprnfor, amprp, tsde
USE time_step, ONLY : delt
USE runcp_module, ONLY : runcp_ncpp
use grid_dimensions, only : nr1, nr2, nr3
USE gvecp, ONLY : ngm
USE io_global, ONLY : ionode, stdout
USE parameters, ONLY : nacx
USE uspp, ONLY : vkb, nkb
!
USE atoms_type_module, ONLY : atoms_type
USE phase_factors_module, ONLY : strucf, phfacs
USE cp_electronic_mass, ONLY : emass
USE print_out_module, ONLY : printout
USE reciprocal_vectors, ONLY : mill_l, gx
!
IMPLICIT NONE
!
COMPLEX(DP), INTENT(OUT) :: eigr(:,:)
COMPLEX(DP), INTENT(OUT) :: ei1(:,:)
COMPLEX(DP), INTENT(OUT) :: ei2(:,:)
COMPLEX(DP), INTENT(OUT) :: ei3(:,:)
COMPLEX(DP), INTENT(OUT) :: sfac(:,:)
REAL(DP), INTENT(OUT) :: rhor(:,:)
REAL(DP), INTENT(OUT) :: bec(:,:)
REAL(DP), INTENT(OUT) :: becdr(:,:,:)
REAL(DP), INTENT(OUT) :: fi(:,:,:)
REAL(DP), INTENT(OUT) :: vpot(:,:)
TYPE(atoms_type) , INTENT(OUT) :: atoms
TYPE(dft_energy_type) , INTENT(OUT) :: edft
TYPE(boxdimensions) , INTENT(INOUT) :: ht
TYPE(wave_descriptor), INTENT(IN) :: cdesc, edesc
COMPLEX(DP), INTENT(INOUT) :: cm(:,:,:,:), c0(:,:,:,:)
COMPLEX(DP), INTENT(INOUT) :: cp(:,:,:,:), ce(:,:,:,:)
!
! ... declare other variables
!
LOGICAL, PARAMETER :: ttprint = .TRUE.
INTEGER, PARAMETER :: nfi = 0
LOGICAL :: ttforce
LOGICAL :: tstress
COMPLEX(DP) :: cgam(1,1,1)
REAL(DP) :: gam(1,1,1)
INTEGER :: ierr
REAL(DP) :: timepre, fccc
REAL(DP) :: s4, s5, cclock
REAL(DP) :: adum( nacx )
REAL(DP) :: hinv( 3, 3 )
INTEGER :: nspin_wfc
INTEGER :: iss
!
!
ttforce = tfor .or. tprnfor
tstress = thdyn .or. tpre
IF( tsde ) THEN
fccc = 1.0d0
ELSE
fccc = 0.5d0
END IF
!
IF ( ANY( tranp ) ) THEN
!
hinv = TRANSPOSE( ht%m1 )
!
CALL randpos( atoms%taus, atoms%na, &
atoms%nsp, tranp, amprp, hinv, atoms%mobile )
!
CALL s_to_r( atoms%taus, atoms%taur, atoms%na, atoms%nsp, ht%hmat )
!
END IF
!
CALL phfacs( ei1, ei2, ei3, eigr, mill_l, &
atoms%taus, nr1, nr2, nr3, atoms%nat )
!
CALL strucf( sfac, ei1, ei2, ei3, mill_l, ngm )
!
! ... initialize wave functions
!
nspin_wfc = nspin
!
IF( force_pairing ) nspin_wfc = 1
!
cm = 0.D0
ce = 0.D0
cp = 0.D0
!
DO iss = 1, nspin_wfc
!
CALL wave_rand_init( cm( :, :, 1, iss ) )
!
END DO
!
IF ( ionode ) &
WRITE( stdout, fmt = '(//,3X, "Wave Initialization: random initial wave-functions" )' )
!
DO iss = 1, nspin_wfc
!
CALL gram( vkb, bec, nkb, cm(1,1,1,iss), SIZE(cm,1), cdesc%nbt( iss ) )
!
END DO
!
c0 = cm
!
! ... initialize bands
!
CALL occn_init( fi )
CALL occn_info( fi )
!
atoms%for = 0.D0
!
! ... compute local form factors
!
CALL formf( .true. , edft%eself )
!
edft%enl = nlrh_m( cm, cdesc, ttforce, atoms, fi, bec, becdr, eigr )
!
CALL rhoofr( 0, cm, cdesc, fi, rhor, ht )
!
CALL vofrhos( ttprint, ttforce, tstress, rhor, atoms, &
vpot, bec, cm, cdesc, fi, eigr, ei1, ei2, ei3, &
sfac, timepre, ht, edft )
!
IF( iprsta > 1 ) CALL debug_energies( edft )
!
IF ( tcarpar ) THEN
!
IF ( .NOT. force_pairing ) THEN
!
CALL runcp_ncpp( cm, cm, c0, cdesc, vpot, eigr, fi, &
bec, fccc, gam, cgam, fromscra = .TRUE. )
!
ELSE
!
c0 = cm
!
END IF
!
IF ( tortho .AND. ( .NOT. force_pairing ) ) THEN
!
CALL ortho( cm, c0, cdesc, pmss, emass )
!
ELSE
!
DO iss = 1, nspin_wfc
!
CALL gram( vkb, bec, nkb, c0(1,1,1,iss), SIZE(c0,1), cdesc%nbt( iss ) )
!
END DO
!
END IF
!
ELSE
!
c0 = cm
!
END IF
!
adum = 0.D0
!
CALL printout( nfi, atoms, 0.0d0, 0.0d0, ttprint, ht, adum, adum, edft )
!
RETURN
!
END SUBROUTINE from_scratch_fpmd
!
!--------------------------------------------------------------------------
SUBROUTINE from_scratch_cp( sfac, eigr, ei1, ei2, ei3, bec, becdr, tfirst, &
eself, fion, taub, irb, eigrb, b1, b2, b3, nfi, &
rhog, rhor, rhos, rhoc, enl, ekin, stress, detot,&
enthal, etot, lambda, lambdam, lambdap, ema0bg, &
dbec, delt, bephi, becp, velh, dt2bye, iforce, &
fionm, xnhe0, xnhem, vnhe, ekincm )
!--------------------------------------------------------------------------
!
USE kinds, ONLY: DP
USE control_flags, ONLY : tranp, trane, trhor, iprsta, tpre, &
tzeroc, tzerop, tzeroe, tfor, thdyn, &
lwf, tprnfor, tortho, amprp, ampre, &
tsde, ortho_eps, ortho_max
USE ions_positions, ONLY : taus, tau0, tausm, vels
USE ions_base, ONLY : na, nsp, randpos, zv, ions_vel, pmass
USE cell_base, ONLY : ainv, h, s_to_r, ibrav, omega, press, &
hold, r_to_s, deth, wmass, iforceh, &
cell_force
use electrons_base, ONLY : nbsp
USE energies, ONLY : entropy
USE uspp, ONLY : vkb, becsum, deeq, nkb
USE wavefunctions_module, ONLY : c0, cm, phi => cp
USE io_global, ONLY : stdout
USE cpr_subroutines, ONLY : compute_stress, print_atomic_var, &
print_lambda, elec_fakekine
USE core, ONLY : nlcc_any
USE gvecw, ONLY : ngw
USE reciprocal_vectors, ONLY : gstart, mill_l
USE gvecs, ONLY : ngs
USE wave_base, ONLY : wave_steepest
USE cvan, ONLY : nvb
USE ions_nose, ONLY : xnhp0, xnhpm, vnhp
USE cell_nose, ONLY : xnhh0, xnhhm, vnhh
USE cp_electronic_mass, ONLY : emass
USE efield_module, ONLY : tefield, efield_berry_setup, &
berry_energy, dforce_efield, &
tefield2, efield_berry_setup2, &
berry_energy2, dforce_efield2
USE cg_module, ONLY : tcg
USE ensemble_dft, ONLY : tens, compute_entropy
USE runcp_module, ONLY : runcp_uspp, runcp_uspp_force_pairing
USE electrons_base, ONLY : f, nspin, nupdwn, iupdwn
USE phase_factors_module, ONLY : strucf
USE orthogonalize, ONLY : ortho
USE orthogonalize_base, ONLY : updatc, calphi
USE control_flags, ONLY : force_pairing
USE charge_density, ONLY : rhoofr
!
IMPLICIT NONE
!
COMPLEX(DP) :: eigr(:,:), ei1(:,:), ei2(:,:), ei3(:,:)
COMPLEX(DP) :: eigrb(:,:)
REAL(DP) :: bec(:,:), fion(:,:), becdr(:,:,:), fionm(:,:)
REAL(DP) :: eself
REAL(DP) :: taub(:,:)
REAL(DP) :: b1(:), b2(:), b3(:)
INTEGER :: irb(:,:)
INTEGER :: nfi, iforce(:,:)
LOGICAL :: tfirst
COMPLEX(DP) :: sfac(:,:)
COMPLEX(DP) :: rhog(:,:)
REAL(DP) :: rhor(:,:), rhos(:,:), rhoc(:), enl, ekin
REAL(DP) :: stress(:,:), detot(:,:), enthal, etot
REAL(DP) :: lambda(:,:,:), lambdam(:,:,:), lambdap(:,:,:)
REAL(DP) :: ema0bg(:)
REAL(DP) :: dbec(:,:,:,:)
REAL(DP) :: delt
REAL(DP) :: bephi(:,:), becp(:,:)
REAL(DP) :: velh(:,:)
REAL(DP) :: dt2bye, xnhe0, xnhem, vnhe, ekincm
!
REAL(DP), ALLOCATABLE :: emadt2(:), emaver(:)
COMPLEX(DP), ALLOCATABLE :: c2(:), c3(:)
REAL(DP) :: verl1, verl2
REAL(DP) :: bigr
INTEGER :: i, j, iter, iss
LOGICAL :: tlast = .FALSE.
REAL(DP) :: ei_unp
INTEGER :: n_spin_start
REAL(DP) :: fcell(3,3), ccc, enb, enbi, fccc
!
!
IF( ANY( tranp( 1:nsp ) ) ) THEN
!
CALL invmat( 3, h, ainv, deth )
!
CALL randpos( taus, na, nsp, tranp, amprp, ainv, iforce )
!
CALL s_to_r( taus, tau0, na, nsp, h )
!
END IF
!
CALL phfac( tau0, ei1, ei2, ei3, eigr )
!
CALL strucf( sfac, ei1, ei2, ei3, mill_l, ngs )
!
CALL initbox ( tau0, taub, irb )
!
CALL phbox( taub, eigrb )
!
if( trane ) then
!
! random initialization
!
CALL randin( 1, nbsp, gstart, ngw, ampre, cm )
!
IF( force_pairing ) THEN
cm(:, iupdwn(2):(iupdwn(2) + nupdwn(2) - 1), 1, 1) = cm(:, 1:nupdwn(2), 1, 1)
c0(:, iupdwn(2):(iupdwn(2) + nupdwn(2) - 1), 1, 1) = c0(:, 1:nupdwn(2), 1, 1)
phi(:, iupdwn(2):(iupdwn(2) + nupdwn(2) - 1), 1, 1) = phi(:, 1:nupdwn(2), 1, 1)
!
lambda(1:nupdwn(2), 1:nupdwn(2), 2) = lambda(:, 1:nupdwn(2), 1)
lambdam(1:nupdwn(2), 1:nupdwn(2), 2) = lambdam(:, 1:nupdwn(2), 1)
lambdap(1:nupdwn(2), 1:nupdwn(2), 2) = lambdap(:, 1:nupdwn(2), 1)
ENDIF
!
else
!
! gaussian initialization
!
! CALL gausin( eigr, cm ) ! DEBUG to be check
end if
!
! ... prefor calculates vkb (used by gram)
!
CALL prefor( eigr, vkb )
!
CALL gram( vkb, bec, nkb, cm, ngw, nbsp )
if( iprsta .ge. 3 ) CALL dotcsc( eigr, cm )
hold = h
velh = 0.0d0
fion = 0.0d0
tausm = taus
vels = 0.0d0
lambdam = lambda
IF( tsde ) THEN
fccc = 1.0d0
ELSE
fccc = 0.5d0
END IF
!
CALL formf( tfirst, eself )
IF( tefield ) THEN
CALL efield_berry_setup( eigr, tau0 )
END IF
IF( tefield2 ) THEN
CALL efield_berry_setup2( eigr, tau0 )
END IF
IF( .NOT. tcg ) THEN
CALL calbec ( 1, nsp, eigr, cm, bec )
if (tpre) CALL caldbec( ngw, nkb, nbsp, 1, nsp, eigr, cm, dbec, .true. )
CALL initbox ( tau0, taub, irb )
CALL phbox( taub, eigrb )
!
CALL rhoofr ( nfi, cm(:,:,1,1), irb, eigrb, bec, becsum, rhor, rhog, rhos, enl, ekin )
!
! put core charge (if present) in rhoc(r)
!
if ( nlcc_any ) CALL set_cc( irb, eigrb, rhoc )
IF( tens ) THEN
CALL compute_entropy( entropy, f(1), nspin )
entropy = entropy * nbsp
END IF
CALL vofrho( nfi, rhor(1,1), rhog(1,1), rhos(1,1), rhoc(1), tfirst, tlast, &
& ei1(1,1), ei2(1,1), ei3(1,1), irb(1,1), eigrb(1,1), sfac(1,1), &
& tau0(1,1), fion(1,1) )
IF( tefield ) THEN
CALL berry_energy( enb, enbi, bec, cm(:,:,1,1), fion )
etot = etot + enb + enbi
END IF
IF( tefield2 ) THEN
CALL berry_energy2( enb, enbi, bec, cm(:,:,1,1), fion )
etot = etot + enb + enbi
END IF
CALL compute_stress( stress, detot, h, omega )
if(iprsta.gt.2) CALL print_atomic_var( fion, na, nsp, ' fion ' )
CALL newd( rhor, irb, eigrb, becsum, fion )
CALL prefor( eigr, vkb )
!
!
IF( force_pairing ) THEN
!
CALL runcp_uspp_force_pairing( nfi, fccc, ccc, ema0bg, dt2bye, rhos, bec,&
cm(:,:,1,1), c0(:,:,1,1), ei_unp, fromscra = .TRUE. )
ELSE
!
CALL runcp_uspp( nfi, fccc, ccc, ema0bg, dt2bye, rhos, bec, &
cm(:,:,1,1), c0(:,:,1,1), fromscra = .TRUE. )
END IF
!
! nlfq needs deeq bec
!
if( tfor .or. tprnfor ) CALL nlfq( cm, eigr, bec, becdr, fion )
!
! calphi calculates phi
! the electron mass rises with g**2
!
CALL calphi( cm, ngw, bec, nkb, vkb, phi, nbsp, ema0bg )
if( tortho ) then
CALL ortho( eigr, c0(:,:,1,1), phi(:,:,1,1), lambda, bigr, iter, ccc, bephi, becp )
else
CALL gram( vkb, bec, nkb, c0, ngw, nbsp )
endif
!
!
if ( tfor .or. tprnfor ) CALL nlfl( bec, becdr, lambda, fion )
if ( iprsta >= 3 ) CALL print_lambda( lambda, nbsp, 9, ccc )
if ( tpre ) CALL nlfh( bec, dbec, lambda )
!
IF ( tortho ) THEN
n_spin_start = nspin
IF( force_pairing ) n_spin_start = 1
DO iss = 1, n_spin_start
CALL updatc( ccc, nbsp, lambda(:,:,iss), SIZE(lambda,1), phi, SIZE(phi,1), &
bephi, SIZE(bephi,1), becp, bec, c0, nupdwn(iss), iupdwn(iss) )
END DO
END IF
IF( force_pairing ) THEN
c0( : , iupdwn(2): (iupdwn(2)+nupdwn(2) - 1), 1 , 1 ) = c0( : , 1 : nupdwn(2) , 1, 1 )
phi( : , iupdwn(2): (iupdwn(2)+nupdwn(2) - 1), 1 , 1 ) = phi( : , 1 : nupdwn(2) , 1, 1 )
lambda(1:nupdwn(2), 1:nupdwn(2), 2) = lambda(1:nupdwn(2), 1 : nupdwn(2), 1)
ENDIF
!
!
CALL calbec ( nvb+1, nsp, eigr, c0, bec )
if ( tpre ) CALL caldbec( ngw, nkb, nbsp, 1, nsp, eigr, cm, dbec, .true. )
if(iprsta.ge.3) CALL dotcsc(eigr,c0)
!
xnhp0=0.
xnhpm=0.
vnhp =0.
fionm=0.
CALL ions_vel( vels, taus, tausm, na, nsp, delt )
xnhh0(:,:)=0.
xnhhm(:,:)=0.
vnhh (:,:) =0.
velh (:,:)=(h(:,:)-hold(:,:))/delt
!
! ======================================================
! kinetic energy of the electrons
! ======================================================
CALL elec_fakekine( ekincm, ema0bg, emass, c0, cm, ngw, nbsp, delt )
xnhe0=0.
xnhem=0.
vnhe =0.
lambdam = lambda
ELSE
!
! ... Cojugate Gradient
!
c0 = cm
!
END IF
!
RETURN
!
END SUBROUTINE from_scratch_cp
!
!
!
!
!--------------------------------------------------------------------------
SUBROUTINE from_scratch_all( sfac, eigr, ei1, ei2, ei3, bec, becdr, tfirst, &
SUBROUTINE from_scratch( sfac, eigr, ei1, ei2, ei3, bec, becdr, tfirst, &
eself, fion, taub, irb, eigrb, b1, b2, b3, nfi, &
rhog, rhor, rhos, rhoc, enl, ekin, stress, detot,&
enthal, etot, lambda, lambdam, lambdap, ema0bg, &
@ -923,7 +439,7 @@ MODULE from_scratch_module
!
RETURN
!
END SUBROUTINE from_scratch_all
END SUBROUTINE from_scratch
!
!=----------------------------------------------------------------------------=!
END MODULE from_scratch_module

6
CPV/gtable.f90
View File

@ -24,6 +24,7 @@ subroutine gtable( ipol, ctable)
use reciprocal_vectors, only: mill_l
use mp, only: mp_sum
use io_global, only: ionode, stdout
use mp_global, only: intra_image_comm
implicit none
integer :: ipol, ctable(ngw,2)
@ -95,7 +96,7 @@ subroutine gtable( ipol, ctable)
endif
enddo
call mp_sum(test)
call mp_sum(test, intra_image_comm)
if(ionode) write(stdout,*) '#not found, gtable: ', test
return
@ -116,6 +117,7 @@ subroutine gtablein( ipol, ctabin)
use reciprocal_vectors, only: mill_l
use mp, only: mp_sum
use io_global, only: ionode, stdout
use mp_global, only: intra_image_comm
implicit none
@ -176,7 +178,7 @@ subroutine gtablein( ipol, ctabin)
endif
enddo
call mp_sum(test)
call mp_sum(test, intra_image_comm)
if(ionode) write(stdout,*) '#not found, gtabin: ', test
return

14
CPV/guess.f90
View File

@ -52,7 +52,7 @@ MODULE guess
! ----------------------------------------------
! ... declare modules
USE mp_global, ONLY : nproc, mpime, group
USE mp_global, ONLY : nproc, mpime, intra_image_comm
USE wave_types, ONLY : wave_descriptor
USE control_flags, ONLY : force_pairing
USE uspp, ONLY : vkb, nkb
@ -164,7 +164,7 @@ MODULE guess
ALLOCATE(crot(ngw,n))
CALL ucalc(cm(:,:,1,1),c0(:,:,1,1),ngw,cdesc%gzero,n,uu)
CALL rep_matmul_drv('T','N',n,n,n,1.0d0,uu,n,uu,n,0.0d0,a,n,group)
CALL rep_matmul_drv('T','N',n,n,n,1.0d0,uu,n,uu,n,0.0d0,a,n,intra_image_comm)
CALL diagonalize(1,a,SIZE(a,1),costemp,ap,SIZE(ap,1),n,nproc,mpime)
DO j=1,n
DO i=1,n
@ -174,7 +174,7 @@ MODULE guess
DO i=1,n
costh2(i)=1.0d0/sqrt(costemp(n-i+1))
END DO
CALL rep_matmul_drv('N','N',n,n,n,1.0d0,uu,n,a,n,0.0d0,ap,n,group)
CALL rep_matmul_drv('N','N',n,n,n,1.0d0,uu,n,a,n,0.0d0,ap,n,intra_image_comm)
DO j=1,n
DO i=1,n
ap(i,j)=ap(i,j) * costh2(i)
@ -279,7 +279,7 @@ MODULE guess
! ... declare modules
USE mp
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
IMPLICIT NONE
@ -293,7 +293,7 @@ MODULE guess
! ----------------------------------------------
CALL DGEMM('C','N',n,n,ngw,1.0d0,a,n,b,ngw,0.0d0,lambda,n)
CALL mp_sum(lambda,group)
CALL mp_sum(lambda,intra_image_comm)
RETURN
END SUBROUTINE ucalc_kp
@ -307,7 +307,7 @@ MODULE guess
! ... declare modules
USE mp
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
IMPLICIT NONE
@ -341,7 +341,7 @@ MODULE guess
CALL DGER(n,n,-1.0d0,a,2*ngw,b,2*ngw,lambda,n)
END IF
CALL mp_sum(lambda,group)
CALL mp_sum(lambda,intra_image_comm)
DEALLOCATE(tmp)

17
CPV/init_run.f90
View File

@ -257,23 +257,6 @@ SUBROUTINE init_run()
dbec, delt, bephi, becp, velh, dt2/emass, iforce, &
fionm, xnhe0, xnhem, vnhe, ekincm, atoms0, edft, &
ht0, wfill, wempt, occn, vpot )
! IF ( program_name == 'CP90' ) THEN
! !
! CALL from_scratch( sfac, eigr, ei1, ei2, ei3, bec, becdr, .TRUE., &
! eself, fion, taub, irb, eigrb, b1, b2, b3, nfi, &
! rhog, rhor, rhos, rhoc, enl, ekin, stress, detot, &
! enthal, etot, lambda, lambdam, lambdap, ema0bg, &
! dbec, delt, bephi, becp, velh, dt2/emass, iforce, &
! fionm, xnhe0, xnhem, vnhe, ekincm )
! !
! ELSE IF ( program_name == 'FPMD' ) THEN
! !
! CALL from_scratch( rhor, cm, c0, cp, ce, wfill, wempt, eigr, &
! ei1, ei2, ei3, sfac, occn, ht0, atoms0, bec, &
! becdr, vpot, edft )
! !
! END IF
!
ELSE
!

22
CPV/inner_loop.f90
View File

@ -63,7 +63,7 @@
USE local_pseudo, ONLY: vps, rhops
USE io_global, ONLY: io_global_start, stdout, ionode, &
ionode_id
USE mp_global, ONLY: mp_global_start
USE mp_global, ONLY: intra_image_comm
USE dener
USE derho
USE cdvan
@ -76,9 +76,9 @@
USE cg_module, ONLY: ltresh, itercg, etotnew, etotold, &
tcutoff, restartcg, passof, passov, &
passop, ene_ok, numok, maxiter, &
enever, etresh, ene0, hpsi, gi, hi, &
enever, etresh, ene0, &
esse, essenew, dene0, spasso, ene1, &
passo, iter3, enesti, ninner_ef, emme
passo, iter3, enesti, ninner_ef
USE ions_positions, ONLY: tau0
USE mp, ONLY: mp_sum,mp_bcast
use charge_density, only: rhoofr
@ -205,7 +205,7 @@
END IF
END DO
END DO
CALL mp_sum( c0hc0( 1:nss, 1:nss, is ) )
CALL mp_sum( c0hc0( 1:nss, 1:nss, is ), intra_image_comm )
END DO
DO is= 1, nspin
@ -222,8 +222,8 @@
CALL ddiag( nss, nss, epsi0(1,1,is), dval(1), &
z1(1,1,is), 1 )
END IF
CALL mp_bcast( dval, ionode_id )
CALL mp_bcast( z1(:,:,is), ionode_id )
CALL mp_bcast( dval, ionode_id, intra_image_comm )
CALL mp_bcast( z1(:,:,is), ionode_id, intra_image_comm )
DO i= 1, nss
e0( i+istart-1 )= dval( i )
END DO
@ -266,8 +266,8 @@
CALL ddiag( nss, nss, fmatx(1,1,is), dval(1), &
zaux(1,1,is), 1 )
END IF
CALL mp_bcast( dval, ionode_id )
CALL mp_bcast( zaux(:,:,is), ionode_id )
CALL mp_bcast( dval, ionode_id, intra_image_comm )
CALL mp_bcast( zaux(:,:,is), ionode_id, intra_image_comm )
DO i= 1, nss
faux( i+istart-1 )= dval( i )
END DO
@ -341,7 +341,7 @@
END IF
END DO
END DO
CALL mp_sum( c0hc0( 1:nss, 1:nss, is ) )
CALL mp_sum( c0hc0( 1:nss, 1:nss, is ), intra_image_comm )
END DO
DO is= 1, nspin
nss= nupdwn( is )
@ -457,8 +457,8 @@
istart= iupdwn( is )
IF(ionode) CALL ddiag( nss, nss, fmatx(1,1,is), &
dval(1), zaux(1,1,is), 1 )
CALL mp_bcast( dval, ionode_id )
CALL mp_bcast( zaux(:,:,is), ionode_id )
CALL mp_bcast( dval, ionode_id, intra_image_comm )
CALL mp_bcast( zaux(:,:,is), ionode_id, intra_image_comm )
DO i= 1, n
faux( i+istart-1 )= dval( i )
END DO

10
CPV/ksstates.f90
View File

@ -169,7 +169,7 @@ CONTAINS
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE wave_types, ONLY: wave_descriptor
@ -286,7 +286,7 @@ CONTAINS
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE wave_types, ONLY: wave_descriptor
@ -363,7 +363,7 @@ CONTAINS
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE wave_types, ONLY: wave_descriptor
@ -493,7 +493,7 @@ CONTAINS
SUBROUTINE print_ks_states( c, file_name )
USE kinds
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE mp, ONLY: mp_sum
USE io_global, ONLY: ionode, ionode_id
USE io_global, ONLY: stdout
@ -525,7 +525,7 @@ CONTAINS
CALL write_rho_xml( file_name, rpsi2, nr1, nr2, nr3, nr1x, nr2x, dfftp%ipp, dfftp%npp )
CALL mp_sum( charge, group )
CALL mp_sum( charge, intra_image_comm )
IF ( ionode ) THEN
WRITE( stdout,'(3X,A15," integrated charge : ",F14.5)') &

3
CPV/main.f90
View File

@ -123,7 +123,7 @@
USE io_global, ONLY: stdout
USE optical_properties, ONLY: opticalp, optical_closeup
USE wave_functions, ONLY: update_wave_functions
USE mp, ONLY: mp_report, mp_sum, mp_max
USE mp, ONLY: mp_report
USE runsd_module, ONLY: runsd
USE guess, ONLY: guess_closeup
USE input, ONLY: iosys
@ -131,7 +131,6 @@
USE cell_base, ONLY: frich, greash
USE stick_base, ONLY: pstickset
USE electrons_module, ONLY: bmeshset
USE mp_global, ONLY: nproc, mpime, group
USE smallbox_grid_dimensions, ONLY: nr1b, nr2b, nr3b
USE ions_base, ONLY: taui, cdmi, nat, nsp
USE sic_module, ONLY: self_interaction, nat_localisation

6
CPV/nl.f90
View File

@ -342,7 +342,7 @@
USE wave_types, ONLY: wave_descriptor
USE pseudo_projector, ONLY: projector
USE mp, ONLY: mp_sum
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE atoms_type_module, ONLY: atoms_type
USE uspp_param, only: nh, lmaxkb
USE uspp, only: nhtol, nhtolm, indv
@ -444,9 +444,9 @@
! ... since G vectors only span half space, multiply results by two
IF ( cdesc%gamma ) THEN
CALL DSCAL( size( fnl%r ), 2.0d0, fnl%r(1,1,1), 1 )
CALL mp_sum( fnl%r, group )
CALL mp_sum( fnl%r, intra_image_comm )
ELSE
CALL mp_sum( fnl%c, group )
CALL mp_sum( fnl%c, intra_image_comm )
END IF
RETURN

12
CPV/nl_base.f90
View File

@ -111,7 +111,7 @@
!
USE kinds, ONLY : DP
USE mp, ONLY : mp_sum
USE mp_global, ONLY : nproc
USE mp_global, ONLY : nproc, intra_image_comm
USE ions_base, only : na, nax, nat
USE gvecw, only : ngw
USE uspp, only : nkb, nhtol, beta
@ -198,7 +198,7 @@
IF( nproc > 1 ) THEN
inl=ish(is)+1
do i=1,n
CALL mp_sum( becp( inl : (inl + na(is)*nh(is) - 1), i ) )
CALL mp_sum( becp( inl : (inl + na(is)*nh(is) - 1), i ), intra_image_comm )
end do
END IF
@ -234,7 +234,7 @@
use uspp_param, only : nh
use cell_base, only : tpiba
use mp, only : mp_sum
use mp_global, only : nproc
use mp_global, only : nproc, intra_image_comm
use reciprocal_vectors, only: gx, gstart
!
@ -315,7 +315,7 @@
end do
end do
if( tred .AND. ( nproc > 1 ) ) call mp_sum( becdr )
if( tred .AND. ( nproc > 1 ) ) call mp_sum( becdr, intra_image_comm )
deallocate( gk )
deallocate( wrk2 )
@ -534,7 +534,7 @@ SUBROUTINE caldbec( ngw, nkb, n, nspmn, nspmx, eigr, c, dbec, tred )
!
USE kinds, ONLY : DP
use mp, only : mp_sum
use mp_global, only : nproc
use mp_global, only : nproc, intra_image_comm
use ions_base, only : na, nax, nat
use cvan, only : ish
use cdvan, only : dbeta
@ -612,7 +612,7 @@ SUBROUTINE caldbec( ngw, nkb, n, nspmn, nspmx, eigr, c, dbec, tred )
if( ( nproc > 1 ) .AND. tred ) then
inl=ish(is)+1
do ii=1,n
call mp_sum( dbec( inl : (inl + na(is)*nh(is) - 1), ii,i,j) )
call mp_sum( dbec( inl : (inl + na(is)*nh(is) - 1), ii,i,j), intra_image_comm )
end do
end if
isa = isa + na(is)

17
CPV/optical.f90
View File

@ -72,7 +72,7 @@
USE constants, ONLY: au, pi, k_boltzman_au, au_to_ohmcmm1
USE cell_base, ONLY: tpiba2
USE mp, ONLY: mp_sum
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE io_global, ONLY: ionode
USE atoms_type_module, ONLY: atoms_type
USE io_files, ONLY: dielecunit, dielecfile
@ -173,7 +173,7 @@
IF( ionode ) THEN
OPEN(UNIT=dielecunit, FILE=dielecfile, STATUS='unknown', POSITION='append', IOSTAT=ierr)
END IF
CALL mp_sum( ierr )
CALL mp_sum( ierr, intra_image_comm )
IF( ierr /= 0 ) &
CALL errore(' opticalp ', ' opening file '//TRIM(dielecfile), 1 )
@ -238,7 +238,7 @@
AIMAG( ce( ig, cie, ik, ispin ) * CONJG( cf( ig, cif, ik, ispin ) )
END DO
! parallel sum of curr
CALL mp_sum( curr, group )
CALL mp_sum( curr, intra_image_comm )
! the factor 4.0d0 accounts for gamma symmetry
currt = 4.0d0 * (fi(if)-fi(ie)) * ( curr(1)**2 + curr(2)**2 + curr(3)**2 )
currt = currt * tpiba2 / wef
@ -309,7 +309,7 @@
curr(3) = curr(3) + gx(3,ig) * &
AIMAG( ce( ig, ie, ik, ispin ) * CONJG( cf( ig, if, ik, ispin ) ) )
END DO
CALL mp_sum( curr, group )
CALL mp_sum( curr, intra_image_comm )
currt = 2.0d0 * ( curr(1)**2 + curr(2)**2 + curr(3)**2 )
ELSE
ccurr = 0.0d0
@ -321,7 +321,7 @@
ccurr(3) = ccurr(3) + gkx_l(3, ig, ik) * &
ce( ig, ie, ik, ispin ) * CONJG( cf( ig, if, ik, ispin ) )
END DO
CALL mp_sum( ccurr, group )
CALL mp_sum( ccurr, intra_image_comm )
ccurrt = ccurr(1)*CONJG(ccurr(1)) + ccurr(2)*CONJG(ccurr(2)) + ccurr(3)*CONJG(ccurr(3))
WRITE( dielecunit ,100 ) ispin, ik, ie, if, wef, ccurrt
100 FORMAT(4I5,1D14.6,3X,2D14.6)
@ -337,7 +337,7 @@
IF( ionode ) THEN
CLOSE(UNIT=dielecunit, IOSTAT=ierr)
END IF
CALL mp_sum( ierr )
CALL mp_sum( ierr, intra_image_comm )
IF( ierr /= 0 ) &
CALL errore(' opticalp ', ' opening file '//TRIM(dielecfile), 1 )
@ -360,6 +360,7 @@
USE constants, ONLY: au, au_to_ohmcmm1
USE io_files, ONLY: dielecunit, dielecfile
USE io_global, ONLY: ionode
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
INTEGER, INTENT(IN) :: nfi
@ -373,7 +374,7 @@
IF( ionode ) THEN
OPEN(UNIT=dielecunit, FILE=dielecfile, STATUS='unknown', POSITION='append', IOSTAT=ierr)
END IF
CALL mp_sum( ierr )
CALL mp_sum( ierr, intra_image_comm )
IF( ierr /= 0 ) &
CALL errore(' write_dielec ', ' opening file '//TRIM(dielecfile), 1 )
@ -390,7 +391,7 @@
IF( ionode ) THEN
CLOSE(UNIT=dielecunit, IOSTAT=ierr)
END IF
CALL mp_sum( ierr )
CALL mp_sum( ierr, intra_image_comm )
IF( ierr /= 0 ) &
CALL errore(' write_dielec ', ' closing file '//TRIM(dielecfile), 1 )

35
CPV/ortho_base.f90
View File

@ -51,7 +51,7 @@ CONTAINS
! ... Multiply square matrices A, B and return the result in C
USE control_flags, ONLY: iprsta
USE mp_global, ONLY: nproc, mpime, root, group
USE mp_global, ONLY: nproc, mpime, root, intra_image_comm
USE io_global, ONLY: ionode, stdout
USE mp, ONLY: mp_bcast
@ -92,11 +92,12 @@ CONTAINS
IF( calls_cnt < 3 ) t1 = cclock()
CALL rep_matmul_drv( transa, transb, n, n, n, one, A, SIZE(a,1), B, SIZE(b,1), zero, C, SIZE(c,1), group )
CALL rep_matmul_drv( transa, transb, n, n, n, one, A, SIZE(a,1), B, SIZE(b,1), zero, C, &
SIZE(c,1), intra_image_comm )
IF( calls_cnt < 3 ) THEN
tpar = cclock() - t1
CALL mp_bcast( tpar, root, group )
CALL mp_bcast( tpar, root, intra_image_comm )
END IF
ELSE
@ -107,7 +108,7 @@ CONTAINS
IF( calls_cnt < 3 ) THEN
tser = cclock() - t1
CALL mp_bcast( tser, root, group )
CALL mp_bcast( tser, root, intra_image_comm )
END IF
END IF
@ -124,7 +125,7 @@ CONTAINS
! Diagonalization of rhos
USE control_flags, ONLY: iprsta
USE mp_global, ONLY: nproc, mpime, group, root
USE mp_global, ONLY: nproc, mpime, intra_image_comm, root
USE io_global, ONLY: ionode, stdout
USE mp, ONLY: mp_sum, mp_bcast
!
@ -192,13 +193,13 @@ CONTAINS
DEALLOCATE( diag, vv )
CALL mp_sum( s )
CALL mp_sum( s, intra_image_comm )
IF( calls_cnt < 3 ) THEN
tpar = cclock() - t1
CALL mp_bcast( tpar, root, group )
CALL mp_bcast( tpar, root, intra_image_comm )
END IF
@ -218,7 +219,7 @@ CONTAINS
tser = cclock() - t1
CALL mp_bcast( tser, root, group )
CALL mp_bcast( tser, root, intra_image_comm )
END IF
@ -236,7 +237,7 @@ CONTAINS
! this routine calls the appropriate Lapack routine for diagonalizing a
! complex Hermitian matrix
USE mp_global, ONLY: nproc, mpime
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE mp, ONLY: mp_sum
IMPLICIT NONE
@ -272,7 +273,7 @@ CONTAINS
CALL pzpack(ap, a)
CALL pzhpev_drv( 'V', ap, nrl, d, vp, nrl, nrl, n, nproc, mpime)
CALL pzunpack(a, vp)
CALL mp_sum(a, ev)
CALL mp_sum(a, ev, intra_image_comm)
DEALLOCATE(ap, vp)
@ -515,7 +516,7 @@ CONTAINS
USE kinds, ONLY: DP
USE io_global, ONLY: stdout
USE control_flags, ONLY: ortho_eps, ortho_max
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
IMPLICIT NONE
@ -634,6 +635,7 @@ CONTAINS
USE mp, ONLY: mp_sum
USE control_flags, ONLY: iprsta
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
!
IMPLICIT NONE
!
@ -660,7 +662,7 @@ CONTAINS
END DO
END IF
!
CALL mp_sum( sig )
CALL mp_sum( sig, intra_image_comm )
!
DO i = 1, nss
sig(i,i) = sig(i,i) + 1.0d0
@ -715,6 +717,7 @@ CONTAINS
USE cvan, ONLY: nvb
USE kinds, ONLY: DP
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
USE control_flags, ONLY: iprsta
USE io_global, ONLY: stdout
!
@ -746,7 +749,7 @@ CONTAINS
END DO
END IF
CALL mp_sum( rho )
CALL mp_sum( rho, intra_image_comm )
!
IF( nvb > 0 ) THEN
!
@ -798,6 +801,7 @@ CONTAINS
USE mp, ONLY: mp_sum
USE control_flags, ONLY: iprsta
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
!
IMPLICIT NONE
INTEGER :: nss, ist, ngwx, nkbx, n, nx
@ -823,7 +827,7 @@ CONTAINS
END DO
END IF
CALL mp_sum( tau )
CALL mp_sum( tau, intra_image_comm )
!
IF( nvb > 0 ) THEN
!
@ -972,6 +976,7 @@ CONTAINS
USE kinds, ONLY: DP
USE ions_base, ONLY: na, nsp
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE cvan, ONLY: ish, nvb
USE uspp_param, ONLY: nh
USE uspp, ONLY: nhsavb=>nkbus, qq
@ -1061,7 +1066,7 @@ CONTAINS
END IF
emtot=emtot/n
CALL mp_sum( emtot )
CALL mp_sum( emtot, intra_image_comm )
WRITE( stdout,*) 'in calphi sqrt(emtot)=',SQRT(emtot)
WRITE( stdout,*)

59
CPV/para.f90
View File

@ -98,60 +98,6 @@
end subroutine read_rho
!
!
!-----------------------------------------------------------------------
subroutine reduce(size,ps)
!-----------------------------------------------------------------------
!
! sums a distributed variable s(size) over the processors.
! This version uses a fixed-length buffer of appropriate (?) size
!
use parallel_include
use mp_global, only: nproc
!
implicit none
integer size
real(8) ps(size)
!
integer ierr, n, nbuf
integer, parameter:: MAXB=10000
real(8) buff(MAXB)
!
if (nproc.le.1) return
if (size.le.0) return
call start_clock( 'reduce' )
!
! syncronize processes
!
#if defined __PARA
call mpi_barrier(MPI_COMM_WORLD,ierr)
if (ierr.ne.0) call errore('reduce','error in barrier',ierr)
!
nbuf=size/MAXB
!
do n=1,nbuf
call mpi_allreduce (ps(1+(n-1)*MAXB), buff, MAXB, &
& MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
if (ierr.ne.0) &
& call errore('reduce','error in allreduce1',ierr)
call DCOPY(MAXB,buff,1,ps(1+(n-1)*MAXB),1)
end do
!
! possible remaining elements < maxb
!
if (size-nbuf*MAXB.gt.0) then
call mpi_allreduce (ps(1+nbuf*MAXB), buff, size-nbuf*MAXB, &
& MPI_DOUBLE_PRECISION, MPI_SUM, MPI_COMM_WORLD, ierr)
if (ierr.ne.0) &
& call errore('reduce','error in allreduce2',ierr)
call DCOPY(size-nbuf*MAXB,buff,1,ps(1+nbuf*MAXB),1)
endif
#endif
call stop_clock( 'reduce' )
!
return
end subroutine reduce
!
!----------------------------------------------------------------------
subroutine nrbounds(ngw,nr1s,nr2s,nr3s,mill,nmin,nmax)
!----------------------------------------------------------------------
@ -162,6 +108,7 @@
!
use parallel_include
use mp, only: mp_min, mp_max
use mp_global, only: intra_image_comm
implicit none
! input
integer ngw,nr1s,nr2s,nr3s,mill(3,*)
@ -189,8 +136,8 @@
!
! find minima and maxima for the FFT box across all nodes
!
CALL mp_min( nmin0 )
CALL mp_max( nmax0 )
CALL mp_min( nmin0, intra_image_comm )
CALL mp_max( nmax0, intra_image_comm )
nmin = nmin0
nmax = nmax0

34
CPV/polarization.f90
View File

@ -48,7 +48,7 @@
USE cell_module, ONLY: S_TO_R
USE atoms_type_module, ONLY: atoms_type
USE ions_base, ONLY: zv
USE mp_global, ONLY: mpime, nproc, gid => group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE mp_wave, ONLY: pwscatter
IMPLICIT NONE
@ -159,24 +159,24 @@
dumm = 0.0d0
DO IN2 = 1, N
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,1), sour_indi(:,1), &
dest_indi(:,1), n_indi_rcv(1), n_indi_snd(1), icntix(1), mpime, nproc, gid )
dest_indi(:,1), n_indi_rcv(1), n_indi_snd(1), icntix(1), mpime, nproc, intra_image_comm )
DO IN1 = IN2, N
ztmp = ZDOTC( NGW, C2(1,IN1), 1, PTEMP(1), 1 )
call mp_sum( ztmp, gid )
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=ztmp
ENDDO
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,3), sour_indi(:,3), &
dest_indi(:,3), n_indi_rcv(3), n_indi_snd(3), icntix(3), mpime, nproc, gid )
dest_indi(:,3), n_indi_rcv(3), n_indi_snd(3), icntix(3), mpime, nproc, intra_image_comm )
DO IN1=IN2,N
ztmp = ZDOTU( NGW, C2(1,IN1), 1, PTEMP(1), 1 )
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=DUMM(IN1,IN2)+ztmp
ENDDO
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,2), sour_indi(:,2), &
dest_indi(:,2), n_indi_rcv(2), n_indi_snd(2), icntix(2), mpime, nproc, gid )
dest_indi(:,2), n_indi_rcv(2), n_indi_snd(2), icntix(2), mpime, nproc, intra_image_comm )
DO IN1=IN2,N
ztmp = ZDOTC(NGW,PTEMP(1),1,C2(1,IN1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=DUMM(IN1,IN2) + ztmp
ENDDO
DO IN1=1,IN2-1
@ -203,25 +203,25 @@
dumm = 0.0d0
DO IN2=1,N
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,4), sour_indi(:,4), &
dest_indi(:,4), n_indi_rcv(4), n_indi_snd(4), icntix(4), mpime, nproc, gid )
dest_indi(:,4), n_indi_rcv(4), n_indi_snd(4), icntix(4), mpime, nproc, intra_image_comm )
!. contiene il termine ig=0
DO IN1=IN2,N
ztmp = ZDOTC(NGW,C2(1,IN1),1,PTEMP(1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=ztmp
ENDDO
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,6), sour_indi(:,6), &
dest_indi(:,6), n_indi_rcv(6), n_indi_snd(6), icntix(6), mpime, nproc, gid )
dest_indi(:,6), n_indi_rcv(6), n_indi_snd(6), icntix(6), mpime, nproc, intra_image_comm )
DO IN1=IN2,N
ztmp = ZDOTU(NGW,C2(1,IN1),1,PTEMP(1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=DUMM(IN1,IN2) + ztmp
ENDDO
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,5), sour_indi(:,5), &
dest_indi(:,5), n_indi_rcv(5), n_indi_snd(5), icntix(5), mpime, nproc, gid )
dest_indi(:,5), n_indi_rcv(5), n_indi_snd(5), icntix(5), mpime, nproc, intra_image_comm )
DO IN1=IN2,N
ztmp = ZDOTC(NGW,PTEMP(1),1,C2(1,IN1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=DUMM(IN1,IN2) + ztmp
ENDDO
! simmetrizzo
@ -248,18 +248,18 @@
dumm = 0.0d0
DO IN2=1,N
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,7), sour_indi(:,7), &
dest_indi(:,7), n_indi_rcv(7), n_indi_snd(7), icntix(7), mpime, nproc, gid )
dest_indi(:,7), n_indi_rcv(7), n_indi_snd(7), icntix(7), mpime, nproc, intra_image_comm )
!. contiene il termine ig=0
DO IN1=IN2,N
ztmp = ZDOTC(NGW,C2(1,IN1),1,PTEMP(1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=ztmp
ENDDO
call pwscatter( C2(:,in2), PTEMP, ngw, indi_l(:,8), sour_indi(:,8), &
dest_indi(:,8), n_indi_rcv(8), n_indi_snd(8), icntix(8), mpime, nproc, gid )
dest_indi(:,8), n_indi_rcv(8), n_indi_snd(8), icntix(8), mpime, nproc, intra_image_comm )
DO IN1=IN2,N
ztmp = ZDOTC(NGW,PTEMP(1),1,C2(1,IN1),1)
call mp_sum(ztmp,gid)
call mp_sum( ztmp, intra_image_comm )
DUMM(IN1,IN2)=DUMM(IN1,IN2)+ztmp
ENDDO
! simmetrizzo

30
CPV/potentials.f90
View File

@ -95,7 +95,7 @@
USE constants, ONLY: fpi
USE cell_base, ONLY: tpiba2, tpiba
USE mp, ONLY: mp_sum
USE mp_global, ONLY: nproc, mpime, group, root
USE mp_global, ONLY: nproc, mpime, intra_image_comm, root
USE io_global, ONLY: ionode
USE gvecp, ONLY: ngm
USE reciprocal_vectors, ONLY: gstart, gx, g
@ -158,7 +158,7 @@
END DO
vrmean(ir) = 2.0d0 * vrmean(ir)
END DO
CALL mp_sum(vrmean,group)
CALL mp_sum( vrmean, intra_image_comm )
IF(ionode) THEN
DO ir = 1, vhnr
@ -259,7 +259,7 @@
! ... include modules
USE control_flags, ONLY: tscreen, tchi2, iprsta, force_pairing
USE mp_global, ONLY: nproc, mpime, root, group
USE mp_global, ONLY: nproc, mpime, root, intra_image_comm
USE mp, ONLY: mp_sum
USE cell_module, ONLY: boxdimensions
USE cell_base, ONLY: tpiba2
@ -669,21 +669,21 @@
! ... sum up forces
IF (tforce) THEN
CALL mp_sum(fion, group)
CALL mp_sum(fion, intra_image_comm)
END IF
! WRITE(6,*) 'DEBUG end = ', SUM(fion)
! ... sum up energies
CALL mp_sum(eps, group)
CALL mp_sum(edft%sxc, group)
CALL mp_sum(edft%self_sxc, group)
CALL mp_sum(vxc, group)
CALL mp_sum(edft%eh, group)
CALL mp_sum(edft%ehte, group)
CALL mp_sum(edft%ehti, group)
CALL mp_sum(edft%self_ehte, group)
CALL mp_sum(eps, intra_image_comm)
CALL mp_sum(edft%sxc, intra_image_comm)
CALL mp_sum(edft%self_sxc, intra_image_comm)
CALL mp_sum(vxc, intra_image_comm)
CALL mp_sum(edft%eh, intra_image_comm)
CALL mp_sum(edft%ehte, intra_image_comm)
CALL mp_sum(edft%ehti, intra_image_comm)
CALL mp_sum(edft%self_ehte, intra_image_comm)
! CALL mp_sum(edft%ekin, group) ! already summed up
CALL mp_sum(edft%emkin, group)
CALL mp_sum(edft%emkin, intra_image_comm)
CALL total_energy(edft,omega,vxc,eps,self_vxc,nr1*nr2*nr3)
@ -1093,7 +1093,7 @@
USE constants, ONLY : sqrtpm1
USE cell_module, ONLY : s_to_r, pbcs
USE mp_global, ONLY : nproc, mpime, group
USE mp_global, ONLY : nproc, mpime, intra_image_comm
USE mp, ONLY : mp_sum
USE ions_base, ONLY : rcmax, zv, nsp, na, nax
@ -1293,7 +1293,7 @@
END DO
END DO
CALL mp_sum(esr, group)
CALL mp_sum(esr, intra_image_comm)
DEALLOCATE(iatom)
DEALLOCATE(rc)

6
CPV/print_out.f90
View File

@ -290,7 +290,7 @@
toptical, tconjgrad
use constants, only: factem, au_gpa, au, amu_si, bohr_radius_cm, scmass
use energies, only: print_energies, dft_energy_type
use mp_global, only: mpime
use mp_global, only: mpime, intra_image_comm
use electrons_module, only: print_eigenvalues
use brillouin, only: kpoints, kp
use time_step, ONLY: tps
@ -638,7 +638,7 @@
SUBROUTINE print_sfac( rhoe, sfac )
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE mp, ONLY: mp_max, mp_get, mp_put
USE reciprocal_vectors, ONLY: ig_l2g, gx, g
USE gvecp, ONLY: ngm
@ -660,7 +660,7 @@
nspin = SIZE(rhoe,2)
nsp = SIZE(sfac,2)
ngx_l = ngm
CALL mp_max(ngx_l, group)
CALL mp_max(ngx_l, intra_image_comm)
ALLOCATE(rhoeg(ngm,nspin))
ALLOCATE(hg_rcv(ngx_l))
ALLOCATE(gx_rcv(3,ngx_l))

10
CPV/pseudopot.f90
View File

@ -276,6 +276,7 @@ CONTAINS
!
USE mp, ONLY: mp_max
USE io_global, ONLY: stdout
USE mp_global, ONLY: intra_image_comm
USE cell_base, ONLY: tpiba
USE control_flags, ONLY: iprsta
!
@ -288,7 +289,7 @@ CONTAINS
chkpstab = .FALSE.
!
xgmax = tpiba * SQRT( MAXVAL( hg ) )
CALL mp_max(xgmax)
CALL mp_max( xgmax, intra_image_comm )
!
IF( xgmax > xgtabmax ) THEN
chkpstab = .TRUE.
@ -306,7 +307,7 @@ CONTAINS
!
USE cell_base, ONLY: tpiba, tpiba2
USE mp, ONLY: mp_max
USE mp_global, ONLY: mpime, group, nproc
USE mp_global, ONLY: mpime, intra_image_comm, nproc
USE reciprocal_vectors, ONLY: g
!
REAL(DP), INTENT(OUT) :: xgmax, xgmin, xgtabmax
@ -319,7 +320,7 @@ CONTAINS
!
xgmin = 0.0d0
xgmax = tpiba * SQRT( MAXVAL( g ) )
CALL mp_max(xgmax, group)
CALL mp_max(xgmax, intra_image_comm)
xgmax = xgmax + (xgmax-xgmin)
dxg = (xgmax - xgmin) / DBLE(nval-1)
!
@ -980,6 +981,7 @@ CONTAINS
USE kinds, ONLY : DP
USE betax, ONLY : refg
USE mp, ONLY : mp_max
USE mp_global, ONLY : intra_image_comm
USE gvecw, ONLY: ngw
USE cell_base, ONLY: tpiba2
USE small_box, ONLY: tpibab
@ -998,7 +1000,7 @@ CONTAINS
!
gmax = MAX( gg, ggb )
!
CALL mp_max( gmax )
CALL mp_max( gmax, intra_image_comm )
!
check_tables = .FALSE.
IF( ( INT( gmax ) + 2 ) > mmx ) check_tables = .TRUE.

3
CPV/qmatrixd.f90
View File

@ -32,6 +32,7 @@ subroutine qmatrixd(c0, bec0,ctable, gqq, qmat, detq)
use uspp, only : nhsa=> nkb
use electrons_base, only: nx => nbspx, n => nbsp, ispin
use mp, only: mp_sum
use mp_global, only: intra_image_comm
implicit none
@ -89,7 +90,7 @@ subroutine qmatrixd(c0, bec0,ctable, gqq, qmat, detq)
endif
enddo
call mp_sum(sca)
call mp_sum( sca, intra_image_comm )
endif
qmat(ix,jx)=sca

10
CPV/qqberry.f90
View File

@ -29,6 +29,7 @@ subroutine qqberry2( gqq,gqqm, ipol)
use cell_base, only: a1, a2, a3
use reciprocal_vectors, only: ng0 => gstart, gx, g
use mp, only: mp_sum
use mp_global, only: intra_image_comm
use pseudopotential, only: fill_qrl
implicit none
@ -182,8 +183,8 @@ subroutine qqberry2( gqq,gqqm, ipol)
enddo
endif
call mp_sum(gqq(:,:,:,:))
call mp_sum(gqqm(:,:,:,:))
call mp_sum(gqq(:,:,:,:),intra_image_comm)
call mp_sum(gqqm(:,:,:,:),intra_image_comm)
deallocate( fint)
deallocate( jl)
@ -212,6 +213,7 @@ subroutine qqupdate(eigr, gqqm0, gqq, gqqm, ipol)
use reciprocal_vectors, only: mill_l
use uspp_param, only: nh, nhm
use mp, only: mp_sum
use mp_global, only: intra_image_comm
implicit none
@ -267,8 +269,8 @@ subroutine qqupdate(eigr, gqqm0, gqq, gqqm, ipol)
enddo
enddo
endif
call mp_sum(gqq(:,:,:,:))
call mp_sum(gqqm(:,:,:,:))
call mp_sum(gqq(:,:,:,:),intra_image_comm)
call mp_sum(gqqm(:,:,:,:),intra_image_comm)
return
end subroutine qqupdate

3
CPV/restart.f90
View File

@ -302,8 +302,7 @@
USE cell_module, only: boxdimensions, cell_init, r_to_s, s_to_r
USE brillouin, only: kpoints, kp
use parameters, only: npkx, nsx
USE mp, ONLY: mp_sum, mp_barrier
USE mp_global, ONLY: mpime, nproc, group, root
USE mp_global, ONLY: mpime, nproc, intra_image_comm, root
USE mp_wave, ONLY: mergewf
USE wave_types, ONLY: wave_descriptor
USE control_flags, ONLY: ndr, tbeg, gamma_only

3
CPV/restart_sub.f90
View File

@ -498,10 +498,9 @@ MODULE from_restart_module
USE potentials, ONLY : vofrhos
USE forces, ONLY : dforce_all
USE orthogonalize, ONLY : ortho
USE mp_global, ONLY : mpime, root, nproc, group
USE mp_global, ONLY : mpime, root, nproc, intra_image_comm
USE io_global, ONLY : ionode, ionode_id
USE io_global, ONLY : stdout
USE mp, ONLY : mp_bcast
USE wave_types, ONLY : wave_descriptor
USE pseudo_projector, ONLY : projector
USE control_flags, ONLY : tcarpar, nbeg, tranp, amprp, tfor, tsdp, &

1
CPV/runcg.f90
View File

@ -62,7 +62,6 @@
! ... declare modules
USE mp_global, ONLY: mpime, nproc
USE mp, ONLY: mp_sum
USE energies, ONLY: dft_energy_type, print_energies
USE electrons_module, ONLY: pmss, eigs, nb_l
USE cp_electronic_mass, ONLY: emass

1
CPV/runcg_ion.f90
View File

@ -38,7 +38,6 @@
! ... declare modules
USE mp_global, ONLY: mpime, nproc
USE energies, ONLY: dft_energy_type, print_energies
USE electrons_module, ONLY: emass, pmss, eigs
USE wave_functions, ONLY: update_wave_functions

13
CPV/runcp.f90
View File

@ -40,8 +40,6 @@
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc
USE mp, ONLY: mp_sum
USE electrons_module, ONLY: pmss, eigs, nb_l
USE cp_electronic_mass, ONLY: emass
USE wave_functions, ONLY : cp_kinetic_energy
@ -167,8 +165,6 @@
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc
USE mp, ONLY: mp_sum
USE electrons_module, ONLY: pmss
USE cp_electronic_mass, ONLY: emass
USE wave_base, ONLY: wave_steepest, wave_verlet
@ -333,7 +329,7 @@
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
USE electrons_module, ONLY: pmss, eigs, nb_l, nupdwn, nspin
USE cp_electronic_mass, ONLY: emass
@ -513,8 +509,8 @@
intermed = -2.d0 * sum( c2 * conjg( c0(:, n_unp, ik, 1 ) ) )
intermed3 = sum(c0(:,n_unp, ik, 1) * conjg( c0(:, n_unp, ik, 1)))
CALL mp_sum ( intermed, group )
CALL mp_sum ( intermed3, group )
CALL mp_sum ( intermed, intra_image_comm )
CALL mp_sum ( intermed3, intra_image_comm )
! Eigenvalue of unpaired
ei_unp_mem = intermed
! <Phiunpaired|Phiunpaired>
@ -711,6 +707,7 @@
!
USE electrons_base, ONLY: nx=>nbnd, nupdwn, iupdwn, nbspx, nbsp
USE mp, ONLY: mp_sum
USE mp_global, ONLY: intra_image_comm
!
IMPLICIT NONE
INTEGER, INTENT(in) :: nfi
@ -873,7 +870,7 @@
IF ( gstart == 2 ) cm(1, n_unp) = CMPLX(DBLE(cm(1, n_unp)),0.d0)
!
intermed = -2.d0 * sum(c2 * conjg(c0(:,n_unp)))
CALL mp_sum ( intermed )
CALL mp_sum ( intermed, intra_image_comm )
!
! write(6,*) 'Debug:: ei_unp(au) = ', intermed
!

6
CPV/rundiis.f90
View File

@ -73,7 +73,7 @@ CONTAINS
! ... declare modules
USE kinds
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE mp, ONLY: mp_sum
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
@ -293,7 +293,7 @@ CONTAINS
DO ib=1,nrl
edft%etot = edft%etot + lambda(ib,(ib-1)*nproc+mpime+1)
END DO
CALL mp_sum(edft%etot, group)
CALL mp_sum(edft%etot, intra_image_comm)
IF (ionode) WRITE( stdout,80) idiis, cnorm, edft%etot, edft%ent
80 FORMAT("STEP NORMG ETOT ENT: ",I3,2X,F12.8,2X,F16.6,4(1x,f8.5))
@ -609,7 +609,7 @@ CONTAINS
USE pseudopotential, ONLY: nspnl
USE nl, ONLY: nlsm1_s
USE mp, ONLY: mp_sum
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, nproc, intra_image_comm
USE atoms_type_module, ONLY: atoms_type
USE reciprocal_space_mesh, ONLY: gkx_l, gk_l
USE reciprocal_vectors, ONLY: g, gx

3
CPV/smcp.f90
View File

@ -90,8 +90,6 @@ SUBROUTINE smdmain( tau, fion_out, etot_out, nat_out )
USE cp_main_variables, ONLY : ei1, ei2, ei3, eigr, sfac, irb, taub, &
eigrb, rhog, rhor, rhos, becdr, bephi, &
becp, ema0bg, allocate_mainvar, nfi
USE mp_global, ONLY : mp_global_start
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dfftp
USE orthogonalize, ONLY : ortho
USE orthogonalize_base, ONLY : updatc, calphi
@ -1538,7 +1536,6 @@ SUBROUTINE smdmain( tau, fion_out, etot_out, nat_out )
CALL print_clock( 'fftw' )
CALL print_clock( 'fftb' )
CALL print_clock( 'rsg' )
CALL print_clock( 'reduce' )
END IF
!
!

12
CPV/stress.f90
View File

@ -67,7 +67,7 @@
USE cell_module, ONLY: boxdimensions
USE energies, ONLY: dft_energy_type
USE ions_base, ONLY: nsp
USE mp_global, ONLY: mpime, nproc, group
USE mp_global, ONLY: mpime, intra_image_comm
USE mp, ONLY: mp_sum
USE wave_types, ONLY: wave_descriptor
USE pseudo_projector, ONLY: projector
@ -174,7 +174,7 @@
pail(:,:) = matmul( paiu(:,:), box%m1(:,:) )
CALL mp_sum(pail, group)
CALL mp_sum( pail, intra_image_comm )
DEALLOCATE(gagx_l)
@ -243,7 +243,7 @@
USE pseudopotential, ONLY: nlin_stress, nlin, nspnl, nsanl
USE ions_base, ONLY: nsp, na
USE spherical_harmonics, ONLY: set_dmqm, set_fmrm, set_pmtm
USE mp_global, ONLY: mpime, nproc
USE mp_global, ONLY: mpime, intra_image_comm
USE io_global, ONLY: stdout
USE wave_types, ONLY: wave_descriptor
USE pseudo_projector, ONLY: projector
@ -540,8 +540,8 @@
END DO
detmp = MATMUL( detmp(:,:), htm1(:,:) )
WRITE( stdout,*) "FROM stress_nl derivative of e(nl)"
CALL mp_sum( detmp )
CALL mp_sum( denl_new )
CALL mp_sum( detmp, intra_image_comm )
CALL mp_sum( denl_new, intra_image_comm )
WRITE( stdout,5555) ((detmp(i,j),j=1,3),i=1,3)
WRITE( stdout,5555) ((denl_new(i,j),j=1,3),i=1,3)
END IF
@ -701,7 +701,7 @@
use ions_base, only: nsp, rcmax
USE cell_module, only: boxdimensions
use mp_global, ONLY: mpime, nproc
use mp_global, ONLY: mpime
USE constants, ONLY: fpi
USE cell_base, ONLY: tpiba2
USE reciprocal_vectors, ONLY: gstart, g

7
CPV/turbo.f90
View File

@ -36,9 +36,8 @@
END SUBROUTINE turbo_init
SUBROUTINE allocate_turbo( nnr )
USE io_global, ONLY: ionode
USE io_global, ONLY: stdout
USE io_global, ONLY: ionode, stdout
USE mp_global, ONLY: intra_image_comm
USE mp, ONLY: mp_sum
INTEGER :: nnr
INTEGER :: ierr
@ -48,7 +47,7 @@
END IF
IF( .NOT. ALLOCATED( turbo_states ) ) THEN
ALLOCATE( turbo_states( nnr, nturbo ), STAT = ierr)
CALL mp_sum(ierr)
CALL mp_sum( ierr, intra_image_comm )
IF( ierr /= 0 ) THEN
IF( ionode ) THEN
WRITE( stdout,fmt='(3X,"TURBO: insufficient memory, turbo is switched off ")')

24
CPV/wave.f90
View File

@ -122,7 +122,7 @@
! ... declare modules
USE mp, ONLY: mp_sum
USE mp_global, ONLY: group
USE mp_global, ONLY: intra_image_comm
USE brillouin, ONLY: kpoints, kp
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: wave_speed2
@ -163,7 +163,7 @@
END DO
CALL mp_sum( ekinct, group )
CALL mp_sum( ekinct, intra_image_comm )
cp_kinetic_energy = ekinct / (4.0d0 * dt2)
@ -223,7 +223,7 @@
! ... declare modules
USE mp, ONLY: mp_bcast
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE wave_types, ONLY: wave_descriptor
USE parallel_toolkit, ONLY: pdspev_drv, dspev_drv
@ -276,7 +276,7 @@
IF(mpime.EQ.(ip-1)) THEN
uu = vv
END IF
CALL mp_bcast(uu, (ip-1), group)
CALL mp_bcast(uu, (ip-1), intra_image_comm)
j = ip
DO jl = 1, nrl_ip
@ -306,7 +306,7 @@
! ... declare modules
USE mp, ONLY: mp_bcast
USE mp_global, ONLY: nproc, mpime, group
USE mp_global, ONLY: nproc, mpime, intra_image_comm
USE wave_types, ONLY: wave_descriptor
USE parallel_toolkit, ONLY: pzhpev_drv, zhpev_drv
@ -357,7 +357,7 @@
IF(mpime.EQ.(ip-1)) THEN
uu = vv
END IF
CALL mp_bcast(uu, (ip-1), group)
CALL mp_bcast(uu, (ip-1), intra_image_comm)
DO jl=1,nrl_ip
DO i=1,nx
CALL ZAXPY(ngw,uu(jl,i),c0(1,j,ik),1,c0rot(1,i),1)
@ -392,7 +392,7 @@
! ----------------------------------------------
! ... declare modules
USE mp_global, ONLY: nproc,mpime,group
USE mp_global, ONLY: nproc,mpime,intra_image_comm
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: dotp
@ -452,7 +452,7 @@
! ----------------------------------------------
! ... declare modules
USE mp_global, ONLY: nproc,mpime,group
USE mp_global, ONLY: nproc,mpime,intra_image_comm
USE wave_types, ONLY: wave_descriptor
USE wave_base, ONLY: dotp
@ -683,7 +683,7 @@
SUBROUTINE update_rlambda( i, lambda, c0, cdesc, c2 )
USE electrons_module, ONLY: ib_owner, ib_local
USE mp_global, ONLY: mpime
USE mp_global, ONLY: mpime, intra_image_comm
USE mp, ONLY: mp_sum
USE wave_base, ONLY: hpsi
USE wave_types, ONLY: wave_descriptor
@ -698,7 +698,7 @@
!
ALLOCATE( prod( SIZE( c0, 2 ) ) )
prod = hpsi( cdesc%gzero, c0(:,:), c2 )
CALL mp_sum( prod )
CALL mp_sum( prod, intra_image_comm )
IF( mpime == ib_owner( i ) ) THEN
ibl = ib_local( i )
lambda( ibl, : ) = prod( : )
@ -709,7 +709,7 @@
SUBROUTINE update_clambda( i, lambda, c0, cdesc, c2 )
USE electrons_module, ONLY: ib_owner, ib_local
USE mp_global, ONLY: mpime
USE mp_global, ONLY: mpime, intra_image_comm
USE mp, ONLY: mp_sum
USE wave_base, ONLY: hpsi
USE wave_types, ONLY: wave_descriptor
@ -724,7 +724,7 @@
!
ALLOCATE( prod( SIZE( c0, 2 ) ) )
prod = hpsi( cdesc%gzero, c0(:,:), c2 )
CALL mp_sum( prod )
CALL mp_sum( prod, intra_image_comm )
IF( mpime == ib_owner( i ) ) THEN
ibl = ib_local( i )
lambda( ibl, : ) = prod( : )

33
CPV/wf.f90
View File

@ -43,7 +43,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
USE uspp_param, ONLY : nh, nhm
USE uspp, ONLY : nkb
USE io_global, ONLY : ionode, stdout
USE mp, ONLY : mp_barrier
USE mp, ONLY : mp_barrier, mp_sum
USE mp_global, ONLY : nproc, mpime
USE fft_module, ONLY : invfft
USE fft_base, ONLY : dfftp
@ -872,7 +872,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
qvt=boxdotgridcplx(irb(1,isa),qv,expo(1,inw))
#ifdef __PARA
CALL reduce(2, qvt)
CALL mp_sum( qvt)
#endif
!
IF (nspin.EQ.1) THEN
@ -912,7 +912,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
qvt=0.D0
qvt=boxdotgridcplx(irb(1,isa),qv,expo(1,inw))
#ifdef __PARA
CALL reduce(2, qvt)
CALL mp_sum( qvt)
#endif
!
IF (nspin.EQ.1) THEN
@ -976,7 +976,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
CALL ZGEMM('c','nbsp',nbsp,nbsp,ngw,ONE,c,ngw,c_p,ngw,ONE,X,nbsp)
CALL ZGEMM('T','nbsp',nbsp,nbsp,ngw,ONE,c,ngw,c_m,ngw,ONE,X,nbsp)
#ifdef __PARA
CALL reduce (2*nbsp*nbsp,X)
CALL mp_sum ( X )
#endif
O(inw,:,:)=Oa(inw,:,:)+X(:,:)
IF(iprsta.GT.4) THEN
@ -1004,7 +1004,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
CALL ZGEMM('c','nbsp',nbsp,nupdwn(1),ngw,ONE,c,ngw,c_psp,ngw,ONE,Xsp,nbsp)
CALL ZGEMM('T','nbsp',nbsp,nupdwn(1),ngw,ONE,c,ngw,c_msp,ngw,ONE,Xsp,nbsp)
#ifdef __PARA
CALL reduce (2*nbsp*nupdwn(1),Xsp)
CALL mp_sum ( Xsp )
#endif
DO i=1,nupdwn(1)
DO j=1,nbsp
@ -1031,7 +1031,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
CALL ZGEMM('c','nbsp',nbsp,nupdwn(2),ngw,ONE,c,ngw,c_psp,ngw,ONE,Xsp,nbsp)
CALL ZGEMM('T','nbsp',nbsp,nupdwn(2),ngw,ONE,c,ngw,c_msp,ngw,ONE,Xsp,nbsp)
#ifdef __PARA
CALL reduce (2*nbsp*nupdwn(2),Xsp)
CALL mp_sum ( Xsp )
#endif
DO i=iupdwn(2),nbsp
DO j=1,nbsp
@ -1535,7 +1535,7 @@ SUBROUTINE wfunc_init( clwf, b1, b2, b3, ibrav )
indexplusz, indexminusz, tag, tagp
USE cvan, ONLY : nvb
USE mp, ONLY : mp_barrier, mp_bcast
USE mp_global, ONLY : nproc, mpime
USE mp_global, ONLY : nproc, mpime, intra_image_comm
USE fft_base, ONLY : dfftp
USE parallel_include
!
@ -2501,10 +2501,10 @@ SUBROUTINE wfunc_init( clwf, b1, b2, b3, ibrav )
CALL mp_barrier()
!
CALL mp_bcast( indexplus, root )
CALL mp_bcast( indexminus, root )
CALL mp_bcast( tag, root )
CALL mp_bcast( tagp, root )
CALL mp_bcast( indexplus, root, intra_image_comm )
CALL mp_bcast( indexminus, root, intra_image_comm )
CALL mp_bcast( tag, root, intra_image_comm )
CALL mp_bcast( tagp, root, intra_image_comm )
IF (me.EQ.1) THEN
#endif
@ -3745,7 +3745,7 @@ SUBROUTINE write_psi( c, jw )
USE smooth_grid_dimensions, ONLY : nnrsx, nr3sx, nr1s, nr2s, nr3s
USE gvecw , ONLY : ngw
USE reciprocal_vectors, ONLY : mill_l
USE mp, ONLY : mp_barrier
USE mp, ONLY : mp_barrier, mp_sum
USE fft_base, ONLY : dfftp
USE mp_global, ONLY : nproc, mpime
USE parallel_include
@ -3908,6 +3908,7 @@ SUBROUTINE rhoiofr( nfi, c, irb, eigrb, bec, &
USE uspp_param, ONLY : nh, nhm
USE uspp, ONLY : nkb
USE fft_module, ONLY : fwfft, invfft
USE mp, ONLY : mp_sum
!
IMPLICIT NONE
!
@ -4131,8 +4132,8 @@ SUBROUTINE rhoiofr( nfi, c, irb, eigrb, bec, &
rsumg(iss)=0.0
END DO
END IF
CALL reduce(nspin,rsumg)
CALL reduce(nspin,rsumr)
CALL mp_sum(rsumg)
CALL mp_sum(rsumr)
#endif
IF (nspin.EQ.1) THEN
WRITE( stdout,1) rsumg(1),rsumr(1)
@ -4192,8 +4193,8 @@ SUBROUTINE rhoiofr( nfi, c, irb, eigrb, bec, &
rsumg(iss)=0.0
END DO
END IF
CALL reduce(nspin,rsumg)
CALL reduce(nspin,rsumr)
CALL mp_sum(rsumg)
CALL mp_sum(rsumr)
#endif
IF (nspin.EQ.1) THEN
WRITE( stdout,1) rsumg(1),rsumr(1)

18
Modules/input_parameters.f90
View File

@ -1294,6 +1294,7 @@ MODULE input_parameters
press, wmass, cell_temperature, temph, fnoseh, &
cell_dofree, greash, cell_factor, cell_nstepe, &
cell_damping, press_conv_thr
!
!=----------------------------------------------------------------------------=!
! PHONON Namelist Input Parameters
@ -1387,7 +1388,12 @@ MODULE input_parameters
!
! ... variable added for NEB ( C.S. 17/10/2003 )
!
REAL(DP) :: pos( 3*natx, max_num_of_images ) = 0.D0
REAL(DP) :: pos( 3*natx, max_num_of_images )
!
! ... workaround for IBM xlf bug, compiler can't manage large
! array initialization
!
! DATA pos / 0.0d0 /
!
! ION_VELOCITIES
@ -1479,21 +1485,23 @@ MODULE input_parameters
!
INTEGER :: nconstr_inp = 0
REAL (DP) :: constr_tol_inp = 0.D0
CHARACTER(LEN=20) :: constr_type_inp(natx) = ''
REAL (DP) :: constr_inp(6,natx) = 0
CHARACTER(LEN=20) :: constr_type_inp(natx) = ' '
REAL (DP) :: constr_inp(6,natx) ! xlf bug, cannot initialize array
REAL (DP) :: constr_target(natx) = 0.D0
LOGICAL :: constr_target_set(natx) = .FALSE.
!
! KOHN_SHAM
!
LOGICAL :: tprnks( nbndxx, nspinx ) = .FALSE.
LOGICAL :: tprnks( nbndxx, nspinx )
! logical mask used to specify which kohn sham orbital should be
! written to files 'KS.'
LOGICAL :: tprnks_empty( nbndxx, nspinx ) = .FALSE.
LOGICAL :: tprnks_empty( nbndxx, nspinx )
! logical mask used to specify which empty kohn sham orbital should be
! written to files 'KS_EMP.'
CHARACTER(LEN=256) :: ks_path = './'
!
! CHI2
!

33
Modules/mp.f90
View File

@ -49,7 +49,7 @@
INTERFACE mp_sum
MODULE PROCEDURE mp_sum_i1, mp_sum_iv, mp_sum_im, mp_sum_it, &
mp_sum_r1, mp_sum_rv, mp_sum_rm, mp_sum_rt, &
mp_sum_r1, mp_sum_rv, mp_sum_rm, mp_sum_rt, mp_sum_r4d, &
mp_sum_c1, mp_sum_cv, mp_sum_cm, mp_sum_ct, mp_sum_c4d, &
mp_sum_rmm, mp_sum_cmm
END INTERFACE
@ -1536,6 +1536,36 @@
#endif
END SUBROUTINE mp_sum_rt
!
!------------------------------------------------------------------------------!
!
! Carlo Cavazzoni
!
SUBROUTINE mp_sum_r4d(msg,gid)
IMPLICIT NONE
REAL (DP), INTENT (INOUT) :: msg(:,:,:,:)
INTEGER, OPTIONAL, INTENT(IN) :: gid
INTEGER :: group
INTEGER :: i, msglen, ierr
REAL (DP), ALLOCATABLE :: res(:,:,:,:)
#if defined(__MPI)
msglen = size(msg)
IF( msglen*8 > mp_msgsiz_max ) CALL mp_stop(8938)
group = mpi_comm_world
IF( PRESENT( gid ) ) group = gid
ALLOCATE (res(size(msg,1),size(msg,2),size(msg,3),size(msg,4)), STAT=ierr)
IF (ierr/=0) CALL mp_stop(8204)
CALL mpi_allreduce(msg,res,msglen,mpi_double_precision,mpi_sum,group, ierr)
IF (ierr/=0) CALL mp_stop(8205)
msg = res
DEALLOCATE (res, STAT=ierr)
IF (ierr/=0) CALL mp_stop(8205)
mp_high_watermark = MAX( mp_high_watermark, 8 * msglen )
#endif
END SUBROUTINE mp_sum_r4d
!------------------------------------------------------------------------------!
SUBROUTINE mp_sum_c1(msg,gid)
@ -1690,6 +1720,7 @@
END SUBROUTINE mp_sum_c4d
!------------------------------------------------------------------------------!
SUBROUTINE mp_max_i(msg,gid)
IMPLICIT NONE

9
Modules/read_cards.f90
View File

@ -148,6 +148,15 @@ MODULE read_cards_module
newnfi_card = -1
tnewnfi_card = .FALSE.
!
! ... ion_positions
!
pos = 0.0d0
!
constr_inp = 0.0d0
!
tprnks = .FALSE.
tprnks_empty = .FALSE.
!
CALL init_autopilot()
!
RETURN

2
PW/wgauss.f90
View File

@ -15,7 +15,7 @@ function wgauss (x, n)
!
! --> (n>=0) : Methfessel-Paxton case. See PRB 40, 3616 (1989).
!
! --> (n=-1 ): Cold smearing (Marzari-Vanderbilt). See PRL 82, 3296 (199
! --> (n=-1 ): Cold smearing (Marzari-Vanderbilt). See PRL 82, 3296 (1999)
! 1/2*erf(x-1/sqrt(2)) + 1/sqrt(2*pi)*exp(-(x-1/sqrt(2))**2) + 1/2
!
! --> (n=-99): Fermi-Dirac case: 1.0/(1.0+exp(-x)).