bug fixed in phonon calculation with nosym=.true.

minus_q and related variables where not set properly: minus_q was always
set .false. while instead it may be .true. for some value of q (gamma
for instance).


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

PH/set_irr_nosym.f90

@@ -52,18 +52,13 @@ subroutine set_irr_nosym (nat, at, bg, xq, s, invs, nsym, rtau, &
   ! output: the matrice sending q -> -q+G
 
   logical :: minus_q
-  ! output: if true one symmetry send q -
+  ! output: if true one symmetry send q -> -q+G
   integer :: imode
   ! counter on modes
   !
   !    set the information on the symmetry group
   !
-  nsymq = 1
+  call smallgq (xq,at,bg,s,nsym,irgq,nsymq,irotmq,minus_q,gi,gimq)
-  minus_q = .false.
-  gi (1, 1) = 0.d0
-  gi (2, 1) = 0.d0
-  gi (3, 1) = 0.d0
-  irgq (1) = 1
   !
   !     set the modes
   !
@@ -80,11 +75,16 @@ subroutine set_irr_nosym (nat, at, bg, xq, s, invs, nsym, rtau, &
   !   in the basis of the displacements
   !
   call setv (2 * max_irr_dim * max_irr_dim * 48 * 3 * nat, 0.d0, t, 1)
-
   call setv (2 * max_irr_dim * max_irr_dim * 3 * nat, 0.d0, tmq, 1)
+
   do imode = 1, 3 * nat
      t (1, 1, 1, imode) = (1.d0, 0.d0)
   enddo
 
+  tmq = (0.d0,0.d0)
+  if (minus_q) then
+     tmq (1, 1, :) = (1.d0, 0.d0)
+  end if
+
   return
 end subroutine set_irr_nosym

PH/syme.f90

@@ -18,7 +18,6 @@ subroutine syme (dvsym)
   !
 #include "machine.h"
 
-
   use pwcom
   use parameters, only : DP
   use phcom
@@ -26,7 +25,7 @@ subroutine syme (dvsym)
 
   complex(kind=DP) :: dvsym (nrx1, nrx2, nrx3, nspin, 3)
   complex(kind=DP), allocatable ::  aux (:,:,:,:)
-  ! the potential to symme
+  ! the potential to symmetrize
   ! auxiliary quantity
 
   integer :: is, ri, rj, rk, i, j, k, irot, ipol, jpol
@@ -36,14 +35,17 @@ subroutine syme (dvsym)
   ! counter on symmetries
   ! counter on polarizations
 
+  do is = 1, nspin
+     do ipol = 1, 3
+        dvsym(:,:,:,is,ipol) = CMPLX(REAL(dvsym(:,:,:,is,ipol)),0.d0)
+     end do
+  end do
   if (nsym.eq.1) return
   allocate (aux(nrx1 , nrx2 , nrx3 , 3))    
   do is = 1, nspin
      do ipol = 1, 3
-        call ZCOPY (nrx1 * nrx2 * nrx3, dvsym (1, 1, 1, is, ipol), &
+        call ZCOPY (nrx1*nrx2*nrx3, dvsym(1,1,1,is,ipol), 1, aux(1,1,1,ipol), 1)
-             1, aux (1, 1, 1, ipol), 1)
+        call setv (2*nrx1*nrx2*nrx3, 0.d0, dvsym(1,1,1,is,ipol), 1)
-        call setv (2 * nrx1 * nrx2 * nrx3, 0.d0, dvsym (1, 1, 1, is, ipol) &
-             , 1)
      enddo
      !
      !  symmmetrize
@@ -52,15 +54,15 @@ subroutine syme (dvsym)
         do j = 1, nr2
            do i = 1, nr1
               do irot = 1, nsym
-                 call ruotaijk (s (1, 1, irot), ftau (1, irot), i, j, k, nr1, nr2, &
+                 call ruotaijk (s(1,1,irot), ftau(1,irot), i, j, k, &
-                      nr3, ri, rj, rk)
+                                nr1, nr2, nr3, ri, rj, rk)
                  !
                  !    ruotaijk find the rotated of i,j,k with the inverse of S
                  !
                  do ipol = 1, 3
                     do jpol = 1, 3
-                       dvsym (i, j, k, is, ipol) = dvsym (i, j, k, is, ipol) + s (ipol, &
+                       dvsym(i,j,k,is,ipol) = dvsym(i,j,k,is,ipol) + &
-                            jpol, irot) * aux (ri, rj, rk, jpol)
+                            s(ipol,jpol,irot) * aux(ri,rj,rk,jpol)
                     enddo
                  enddo
               enddo
@@ -68,10 +70,8 @@ subroutine syme (dvsym)
         enddo
      enddo
      do ipol = 1, 3
-        call DSCAL (2 * nrx1 * nrx2 * nrx3, 1.d0 / float (nsym), dvsym (1, &
+        call DSCAL (2*nrx1*nrx2*nrx3, 1.d0/float(nsym), dvsym(1,1,1,is,ipol), 1)
-             1, 1, is, ipol), 1)
      enddo
-
   enddo
   deallocate (aux)
   return