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

@@ -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

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