- Bug fix for a subtle error.

Exchange and Correlation potential was not initialized
  when condition (arhox.gt.1.d-30) was not satisfied.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@6852 c92efa57-630b-4861-b058-cf58834340f0

CPV/cpr.f90

@@ -172,9 +172,9 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
   !
   REAL(DP), ALLOCATABLE :: forceh(:,:)
   !
-  !
   etot_out = 0.D0
   enow     = 1.D9
+  stress   = 0.0D0
   !
   tfirst = .TRUE.
   tlast  = .FALSE.

CPV/cprsub.f90

@@ -551,14 +551,13 @@ subroutine dqvan2b(ngy,iv,jv,is,ylm,dylm,dqg,dqrad,qradb)
   real(DP),    intent(in)  :: qradb( ngb, nbetam*(nbetam+1)/2, lmaxq, nsp )
 
   integer      :: ivs, jvs, ijvs, ivl, jvl, i, ii, ij, l, lp, ig
-  complex(DP) :: sig, z1, z2
+  complex(DP) :: sig, z1, z2, zfac
   !
   ! 
   !       iv  = 1..8     s_1 p_x1 p_z1 p_y1 s_2 p_x2 p_z2 p_y2
   !       ivs = 1..4     s_1 s_2 p_1 p_2
   !       ivl = 1..4     s p_x p_z p_y
   ! 
-
   ivs=indv(iv,is)
   jvs=indv(jv,is)
   !
@@ -617,9 +616,9 @@ subroutine dqvan2b(ngy,iv,jv,is,ylm,dylm,dqg,dqrad,qradb)
      do ij=1,3
         do ii=1,3
            do ig=1,ngy
-              dqg(ig,ii,ij) = dqg(ig,ii,ij) +  sig *                &
+              zfac = ylm(ig,lp) * dqrad(ig,ijvs,l,is,ii,ij)
- &                    ( ylm(ig,lp) * dqrad(ig,ijvs,l,is,ii,ij) -    &
+              zfac = zfac - dylm(ig,lp,ii,ij) * qradb(ig,ijvs,l,is)
- &                     dylm(ig,lp,ii,ij) * qradb(ig,ijvs,l,is)   ) ! SEGNO
+              dqg(ig,ii,ij) = dqg(ig,ii,ij) +  sig * zfac
            end do
         end do
      end do
@@ -712,4 +711,3 @@ SUBROUTINE print_lambda_x( lambda, n, nshow, ccc, iunit )
 3380   FORMAT(9f8.4)
     RETURN
 END SUBROUTINE print_lambda_x
-

CPV/exch_corr.f90

@@ -149,7 +149,7 @@
             end do
          end do
          !
-         dxc = dxc * omega / ( nr1*nr2*nr3 )
+         dxc = dxc * omega / DBLE( nr1*nr2*nr3 )
          !
          call mp_sum ( dxc, intra_image_comm )
          !
@@ -426,6 +426,8 @@ subroutine exch_corr_wrapper(nnr, nspin, grhor, rhor, etxc, v, h)
            CALL xc( arhox, ex, ec, vx(1), vc(1) )
            v(ir,nspin) = e2 * (vx(1) + vc(1) )
            etxc = etxc + e2 * (ex + ec) * rhox
+        else
+           v(ir,nspin) = 0.0D0
         endif
      enddo
 !$omp end parallel do
@@ -454,6 +456,10 @@ subroutine exch_corr_wrapper(nnr, nspin, grhor, rhor, etxc, v, h)
               v(ir,is) = e2 * (vx(is) + vc(is) )
            enddo
            etxc = etxc + e2 * (ex + ec) * rhox
+        else
+           do is = 1, nspin
+              v(ir,is) = 0.0D0
+           end do
         endif
      enddo
   endif

CPV/nl_base.f90

@@ -60,7 +60,7 @@
          !
          IF( nproc_image > 1 ) THEN
             nhx = nh( is ) * na( is )
-            IF( MOD( nhx, 2 ) /= 0 ) nhx = nhx + 1
+            IF( MOD( nhx, 2 ) == 0 ) nhx = nhx + 1
             ALLOCATE( becps( nhx, n ) )
             becps = 0.0d0
          END IF
@@ -727,25 +727,20 @@
       ! local variables
 
       integer :: is, ia, i , iv
-!
 !
       call start_clock( 'calbec' )
+      !
       call nlsm1( n, nspmn, nspmx, eigr, c, bec )
 !
       if ( iprsta > 2 ) then
          WRITE( stdout,*)
          do is=1,nspmx
-            if(nspmx.gt.1) then
+            WRITE( stdout,'(33x,a,i4)') ' calbec: bec (is)',is
-               WRITE( stdout,'(33x,a,i4)') ' calbec: bec (is)',is
+            do ia=1,na(is)
-               WRITE( stdout,'(8f9.4)')                                       &
-     &              ((bec(ish(is)+(iv-1)*na(is)+1,i),iv=1,nh(is)),i=1,n)
-            else
-               do ia=1,na(is)
                   WRITE( stdout,'(33x,a,i4)') ' calbec: bec (ia)',ia
                   WRITE( stdout,'(8f9.4)')                                    &
      &             ((bec(ish(is)+(iv-1)*na(is)+ia,i),iv=1,nh(is)),i=1,n)
-               end do
+            end do
-            end if
          end do
       endif
       call stop_clock( 'calbec' )

CPV/stress.f90

@@ -539,8 +539,9 @@
 
          INTEGER :: k, ig
       
-         DO k = 1, 6
+!$omp parallel do default(shared), private(k)
-            DO ig = 1, ngm          
+         DO ig = 1, ngm          
+            DO k = 1, 6
                gagb( k, ig ) = gx( alpha( k ), ig ) * gx( beta( k ), ig ) * tpiba2
             END DO
          END DO