From 65101eaca3cf85d62251469733dee8afa158eb17 Mon Sep 17 00:00:00 2001 From: umari Date: Fri, 21 Oct 2005 15:37:47 +0000 Subject: [PATCH] Major clean-ups P.U. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@2331 c92efa57-630b-4861-b058-cf58834340f0 --- CPV/efield.f90 | 36 +++++++++++++++++------------------- CPV/qqberry.f90 | 31 ++++++++++--------------------- 2 files changed, 27 insertions(+), 40 deletions(-) diff --git a/CPV/efield.f90 b/CPV/efield.f90 index 4b0d89710..5939e647c 100644 --- a/CPV/efield.f90 +++ b/CPV/efield.f90 @@ -13,8 +13,8 @@ MODULE efield_module SAVE logical :: tefield = .FALSE. - integer :: epol = 3 !direzione campo elettrico - real(8) :: efield = 0.d0 !intensita' campo elettrico + integer :: epol = 3 !direction electric field + real(8) :: efield = 0.d0 !intensity electric field real(8) evalue!strenght of electric field integer ipolp !direction of electric field @@ -49,16 +49,14 @@ CONTAINS END SUBROUTINE efield_init SUBROUTINE efield_info( ) - USE io_global, ONLY: stdout - write (stdout,401) epol, efield - ipolp = epol - evalue = efield + USE io_global, ONLY: ionode,stdout + if(ionode) write (stdout,401) epol, efield 401 format (/4x,'=====================================' & - & /4x,'| CAMPO ELETTRICO ' & + & /4x,'| BERRY PHASE ELECTRIC FIELD ' & & /4x,'=====================================' & - & /4x,'| direzione =',i10,' ' & - & /4x,'| intensita =',f10.5,' a.u. ' & + & /4x,'| direction =',i10,' ' & + & /4x,'| intensity =',f10.5,' a.u. ' & & /4x,'=====================================') RETURN @@ -66,19 +64,21 @@ CONTAINS SUBROUTINE efield_berry_setup( eigr, tau0 ) + USE io_global, ONLY: ionode,stdout IMPLICIT NONE COMPLEX(8), INTENT(IN) :: eigr(:,:) REAL(8), INTENT(IN) :: tau0(:,:) - write(6,'(''before gtable'')') + if(ionode) write(stdout,'(''Initialize Berry phase electric field'')') + ipolp = epol + evalue = efield call gtable(ipolp,ctable(1,1,ipolp)) - write(6,'(''out of gtable'')') call gtablein(ipolp,ctabin(1,1,ipolp)) - write(6,'(''out of gtablein'')') call qqberry2(gqq0,gqqm0,ipolp)!for Vanderbilt pps - write(6,'(''out of qqberry2'')') call qqupdate(eigr,gqqm0,gqq,gqqm,ipolp) - write(6,'(''out of qqupdate'')') - call cofcharge(tau0,cdz0) + !the following line was to keep the center of charge fixed + !when performing molecular dynamics in the presence of an electric + !field + !call cofcharge(tau0,cdz0) RETURN END SUBROUTINE efield_berry_setup @@ -123,19 +123,17 @@ CONTAINS SUBROUTINE berry_energy( enb, enbi, bec, cm, fion ) USE uspp, ONLY: betae => vkb USE ions_positions, ONLY: tau0 - USE control_flags, ONLY: tfor + USE control_flags, ONLY: tfor, tprnfor IMPLICIT NONE real(8), intent(out) :: enb, enbi real(8) :: bec(:,:) real(8) :: fion(:,:) complex(8) :: cm(:,:) call qmatrixd(cm,bec,ctable(1,1,ipolp),gqq,qmat,detq) - write(6,'(''out of qmatrixd'')') call enberry( detq, ipolp,enb) - call berryion(tau0,fion,tfor,ipolp,evalue,enbi) + call berryion(tau0,fion,tfor.or.tprnfor,ipolp,evalue,enbi) pberryel=enb pberryion=enbi - write(6,*) 'Polarizzazione',pberryel,evalue enb=enb*evalue enbi=enbi*evalue END SUBROUTINE berry_energy diff --git a/CPV/qqberry.f90 b/CPV/qqberry.f90 index dc4b673f0..58f384e42 100644 --- a/CPV/qqberry.f90 +++ b/CPV/qqberry.f90 @@ -18,7 +18,7 @@ subroutine qqberry2( gqq,gqqm, ipol) use smallbox_grid_dimensions, only: nr1b, nr2b, nr3b, & nr1bx, nr2bx, nr3bx, nnrb => nnrbx use uspp_param, only: lqmax, nqlc, kkbeta, nbeta, nh, nhm - use uspp, only: indv, lpx, lpl, ap + use uspp, only: indv, lpx, lpl, ap,nhtolm use qrl_mod, only: qrl, cmesh use atom, only: r, rab use core @@ -26,16 +26,14 @@ subroutine qqberry2( gqq,gqqm, ipol) use reciprocal_vectors, only: mill_l use parameters use constants - use cvan, only: oldvan, nvb, indlm + use cvan, only: oldvan, nvb use ions_base use ions_base, only : nas => nax use cell_base, only: a1, a2, a3 use reciprocal_vectors, only: ng0 => gstart, gx, g + use mp, only: mp_sum -#ifdef __PARA - use para_mod -#endif implicit none @@ -83,7 +81,6 @@ subroutine qqberry2( gqq,gqqm, ipol) enddo enddo - if(ipol.eq.1) then gmes=a1(1)**2+a1(2)**2+a1(3)**2 gmes=2*pi/SQRT(gmes) @@ -149,8 +146,8 @@ subroutine qqberry2( gqq,gqqm, ipol) do jv=iv,nh(is) ivs=indv(iv,is) jvs=indv(jv,is) - ivl=indlm(iv,is) - jvl=indlm(jv,is) + ivl=nhtolm(iv,is) + jvl=nhtolm(jv,is) ! ! lpx = max number of allowed y_lm ! lp = composite lm to indentify them @@ -187,10 +184,6 @@ subroutine qqberry2( gqq,gqqm, ipol) do ia=1,na(is) -! gqq(iv,jv,ia,is)=qgbs*eigr(igi,ia,is)!ATTENZIONE era cosi' -! gqq(jv,iv,ia,is)=qgbs*eigr(igi,ia,is) -! gqqm(iv,jv,ia,is)=CONJG(gqq(iv,jv,ia,is)) -! gqqm(jv,iv,ia,is)=CONJG(gqq(iv,jv,ia,is)) gqqm(iv,jv,ia,is)=qgbs gqqm(jv,iv,ia,is)=qgbs @@ -202,11 +195,8 @@ subroutine qqberry2( gqq,gqqm, ipol) enddo endif -#ifdef __PARA - call reduce(2*nhm*nhm*nas*nsp, gqq) - call reduce(2*nhm*nhm*nas*nsp, gqqm) -#endif - + call mp_sum(gqq(:,:,:,:)) + call mp_sum(gqqm(:,:,:,:)) deallocate( fint) deallocate( jl) @@ -234,6 +224,7 @@ subroutine qqupdate(eigr, gqqm0, gqq, gqqm, ipol) use ions_base, only : nas => nax, nat, na, nsp use reciprocal_vectors, only: mill_l use uspp_param, only: nh, nhm + use mp, only: mp_sum implicit none @@ -289,10 +280,8 @@ subroutine qqupdate(eigr, gqqm0, gqq, gqqm, ipol) enddo enddo endif -#ifdef __PARA - call reduce(2*nhm*nhm*nas*nsp, gqq) - call reduce(2*nhm*nhm*nas*nsp, gqqm) -#endif + call mp_sum(gqq(:,:,:,:)) + call mp_sum(gqqm(:,:,:,:)) return end subroutine qqupdate