Commit 7ed42041 authored by Samuel Poncé's avatar Samuel Poncé

Debug use_ws ==.true. in para

The wannier centers were not properly bcasted from loadumat.
A test was added to the test-suite to test the new Wigner-Seitz construction
(epw_base/epw10.in)

Various cleaning.
parent 6488d634
......@@ -76,7 +76,6 @@ readdvscf.o \
readgmap.o \
readmat_shuffle2.o \
readwfc.o \
refold.o \
rigid_epw.o \
rotate_eigenm.o \
rotate_epmat.o \
......@@ -85,7 +84,6 @@ selfen_phon.o \
selfen_pl.o \
set_ndnmbr.o \
setphases_wrap.o \
sgama2.o \
sort.o \
spectral_cumulant.o \
spectral_func.o \
......
......@@ -643,5 +643,154 @@
RETURN
!
END SUBROUTINE createkmap_pw2
!
!-------------------------------------------------------------------------
!
!-----------------------------------------------------------------------
SUBROUTINE refold( ngm_g, mill_g, itoj, jtoi )
!----------------------------------------------------------------------
!
! Map the indices of G+G_0 into those of G
! this is used to calculate electron-phonon matrix elements by
! refolding the k+q points into the first BZ (original k grid)
!
! No parallelization on G-vecs at the moment
! (actually this is done on the global array, but in elphel2.f90
! every processor has just a chunk of the array, I may need some
! communication)
!
! No ultrasoft now
!
! I use the rule : if not found then gmap = 0
! Note that the map will be used only up to npwx (small sphere),
! while the G-vectors lost in the process are on the surface of
! the large sphere (density set).
!
!-----------------------------------------------------------------
USE io_global, ONLY : stdout, meta_ionode
USE io_epw, ONLY : iukgmap
! SP: Sucidal. Produce too much data. Only use for debugging.
! USE control_flags, ONLY : iverbosity
USE kfold
!
IMPLICIT NONE
!
INTEGER :: ngm_g
!! Counter on G-vectors
INTEGER :: mill_g(3,ngm_g)
!! Array of Miller indices of G-vectors in increasing order of G^2
INTEGER :: jtoi(ngm_g)
!! For the i-th G-vector in the sorted list, jtoi(i)
!! returns its index in the unsorted list
INTEGER :: itoj(ngm_g)
!! itoj(i) returns the index of the G-vector in the sorted list
!! that was at i-th position in the unsorted list
INTEGER :: ig0
!! Counter on G_0 vectors
INTEGER :: ig1, ig2
!! Counter on G vectors
INTEGER :: i, j, k
!! Miller indices for G+G_0 vector
INTEGER :: ig1_use, ig2_use, ig2_guess, notfound, guess_skip
!! Temporary G-vectors indices
INTEGER :: indold, indnew
!! Counter on G_0 vectors Indices for writing to file
!
LOGICAL :: tfound
!
!
ALLOCATE( gmap(ngm_g,ng0vec) )
gmap(:,:) = 0
guess_skip = 0
!
! Loop on the inequivalent G_0 vectors
!
DO ig0 = 1, ng0vec
!
IF (ig0 .eq. 1) THEN
WRITE(stdout,'(/5x,"Progress kgmap: ")',advance='no')
indold = 0
ENDIF
indnew = nint( dble(ig0) / dble(ng0vec) * 40 )
IF (indnew.ne.indold) WRITE(stdout,'(a)',advance='no') '#'
indold = indnew
!
!
!
notfound = 0
DO ig1 = 1, ngm_g
!
ig1_use = itoj(ig1)
!
! the initial G vector
!
i = mill_g(1,ig1_use)
j = mill_g(2,ig1_use)
k = mill_g(3,ig1_use)
!
! the final G+G_0 vector
!
i = i + g0vec_all(1,ig0)
j = j + g0vec_all(2,ig0)
k = k + g0vec_all(3,ig0)
!
ig2 = 0
tfound = .false.
!
! try to guess next index
!
ig2_guess = jtoi(ig1_use) + guess_skip
!
IF ((ig2_guess .gt. 0) .AND. (ig2_guess .lt. ngm_g+1)) THEN
!
ig2_guess = itoj(ig2_guess)
!
IF ((i .eq. mill_g(1,ig2_guess)) .AND. (j .eq. mill_g(2,ig2_guess)) .AND. (k .eq. mill_g(3,ig2_guess))) THEN
!
ig2_use = ig2_guess
tfound = .true.
!
ENDIF
!
ENDIF
!
DO WHILE ((.not. tfound) .AND. (ig2 .lt. ngm_g))
!
ig2 = ig2 + 1
ig2_use = itoj(ig2)
tfound = (i .eq. mill_g(1,ig2_use)) .AND. &
(j .eq. mill_g(2,ig2_use)) .AND. &
(k .eq. mill_g(3,ig2_use))
!
ENDDO
!
IF (tfound) THEN
gmap(ig1_use,ig0) = ig2_use
guess_skip = jtoi(ig2_use) - jtoi(ig1_use)
ELSE
gmap(ig1_use,ig0) = 0
notfound = notfound + 1
ENDIF
!
ENDDO
!
ENDDO
!
! output on file for electron-phonon matrix elements
!
IF (.NOT. meta_ionode) iukgmap = stdout
!
DO ig1 = 1, ngm_g
WRITE(iukgmap,'(9i10)') (gmap(ig1,ig0), ig0 = 1, ng0vec)
ENDDO
!
IF (iukgmap .ne. stdout) CLOSE(iukgmap)
WRITE(stdout,*)
!
end subroutine refold
......@@ -165,195 +165,6 @@
END SUBROUTINE ktokpmq
!--------------------------------------------------------
!
!--------------------------------------------------------
SUBROUTINE ktokpmq_fine (xkf_cryst, xk, xq, sign, ipool, nkq, nkq_abs)
!--------------------------------------------------------
!!
!! For a given k point in cart coord, find the index
!! of the corresponding (k + sign*q) point on the fine
!! homogeneous grid
!!
!! In the parallel case, determine also the pool number
!! nkq is the in-pool index, nkq_abs is the absolute
!! index
!!
!--------------------------------------------------------
!
USE kinds, ONLY : DP
USE cell_base, ONLY : at
USE epwcom, ONLY : nkf1, nkf2, nkf3
USE elph2, ONLY : nkqtotf
USE mp_global, ONLY : nproc_pool, npool
USE mp_images, ONLY : nproc_image
USE mp, ONLY : mp_barrier, mp_bcast
!
! m
implicit none
!
INTEGER, INTENT (in) :: sign
!! +1 for searching k+q, -1 for k-q
INTEGER, INTENT (out) :: nkq
!! in the parallel case, the pool hosting the k+-q point
INTEGER, INTENT (out) :: nkq_abs
!! the index of k+sign*q
INTEGER, INTENT (out) :: ipool
!! Index of the pool where the point is
!
REAL(kind=DP), INTENT (in) :: xkf_cryst(3,nkqtotf/2)
!! coordinates of k points and q point
REAL(kind=DP), INTENT (in) :: xk(3)
!! coordinates of k points and q points
REAL(kind=DP), INTENT (in) :: xq(3)
!! Coordinates of k+q point
!
! work variables
!
INTEGER :: kunit
!! the absolute index of k+sign*q (in the full k grid)
real(kind=DP) :: xxk (3), xxq (3)
integer :: n, ik
real(kind=DP) :: xx, yy, zz, xx_c, yy_c, zz_c, eps
logical :: in_the_list, found
!
integer :: iks, nkl, nkr, jpool
!
kunit =1
! loosy tolerance, no problem since we use integer comparisons
eps = 1.d-5
IF (abs(sign).ne.1) call errore('ktokpmq_fine','sign must be +1 or -1',1)
!
! bring k and q in crystal coordinates
!
xxk = xk
xxq = xq
!
CALL cryst_to_cart (1, xxk, at, -1)
CALL cryst_to_cart (1, xxq, at, -1)
!
! check that k is actually on a uniform mesh centered at gamma
!
!print*,'xxk ',xxk(:)
!IF (mpime == 0) THEN
! write(910,*)'xxk ',xxk
! write(910,*)'xxq ',xxq
! write(910,*)'nkf1 ',nkf1
!ENDIf
!print*,'xxk ',xxk(:)
!IF (mpime == 1) THEN
! write(911,*)'xxk ',xxk
! write(911,*)'xxq ',xxq
! write(911,*)'nkf1 ',nkf1
! write(911,*)'xkf_cryst ',xkf_cryst(:,1)
! write(911,*)'xkf_cryst ',xkf_cryst(:,2)
! write(911,*)'xkf_cryst ',xkf_cryst(:,3)
! write(911,*)'xkf_cryst ',xkf_cryst(:,4)
!ENDIF
xx = xxk(1)*nkf1
yy = xxk(2)*nkf2
zz = xxk(3)*nkf3
in_the_list = abs(xx-nint(xx)).le.eps .and. &
abs(yy-nint(yy)).le.eps .and. &
abs(zz-nint(zz)).le.eps
IF (.not.in_the_list) call errore('ktokpmq_fine','is this a uniform k-mesh?',1)
!
IF ( xx .lt. -eps .or. yy .lt. -eps .or. zz .lt. -eps ) &
call errore('ktokpmq_fine','coarse k-mesh needs to be strictly positive in 1st BZ',1)
!
! now add the phonon wavevector and check that k+q falls again on the k grid
!
xxk = xxk + dble(sign) * xxq
!
xx = xxk(1)*nkf1
yy = xxk(2)*nkf2
zz = xxk(3)*nkf3
in_the_list = abs(xx-nint(xx)).le.eps .and. &
abs(yy-nint(yy)).le.eps .and. &
abs(zz-nint(zz)).le.eps
IF (.not.in_the_list) call errore('ktokpmq_fine','k+q does not fall on k-grid',1)
!
! find the index of this k+q in the k-grid
!
! make sure xx, yy and zz are in 1st BZ
!
CALL backtoBZ( xx, yy, zz, nkf1, nkf2, nkf3 )
!
n = 0
found = .false.
DO ik = 1, nkqtotf/2
xx_c = xkf_cryst(1,ik)*nkf1
yy_c = xkf_cryst(2,ik)*nkf2
zz_c = xkf_cryst(3,ik)*nkf3
!
! IF (mpime == 1) THEN
! write(911,*)'ik ',ik
! write(911,*)'xx_c ',xx_c
! write(911,*)'yy_c ',yy_c
! write(911,*)'zz_c ',zz_c
! ENDIF
!
! check that the k-mesh was defined in the positive region of 1st BZ
!
IF ( xx_c .lt. -eps .or. yy_c .lt. -eps .or. zz_c .lt. -eps ) &
call errore('ktokpmq_fine','coarse k-mesh needs to be strictly positive in 1st BZ',1)
!
found = nint(xx_c) .eq. nint(xx) .and. &
nint(yy_c) .eq. nint(yy) .and. &
nint(zz_c) .eq. nint(zz)
IF (found) THEN
n = ik
EXIT
ENDIF
ENDDO
!
! 26/06/2012 RM
! since coarse k- and q- meshes are commensurate, one can easily find n
!
! n = nint(xx) * nk2 * nk3 + nint(yy) * nk3 + nint(zz) + 1
!
IF (n .eq. 0) call errore('ktokpmq_fine','problem indexing k+q',1)
!
! Now n represents the index of k+sign*q in the original k grid.
! In the parallel case we have to find the corresponding pool
! and index in the pool
!
#ifdef __MPI
!
npool = nproc_image/nproc_pool
!
DO jpool = 0, npool-1
!
nkl = kunit * ( nkqtotf / npool )
nkr = ( nkqtotf - nkl * npool ) / kunit
!
! the reminder goes to the first nkr pools (0...nkr-1)
!
IF ( jpool < nkr ) nkl = nkl + kunit
!
! the index of the first k point in this pool
!
iks = nkl * jpool + 1
IF ( jpool >= nkr ) iks = iks + nkr * kunit
!
IF (n.ge.iks) then
ipool = jpool+1
nkq = n - iks + 1
ENDIF
!
ENDDO
!
#else
!
nkq = n
!
#endif
!
nkq_abs = n
!
!--------------------------------------------------------------
END SUBROUTINE ktokpmq_fine
!--------------------------------------------------------------
!
!---------------------------------
SUBROUTINE ckbounds(lower, upper)
!---------------------------------
......
......@@ -136,6 +136,7 @@
CALL mp_bcast(lwin_big, ionode_id, inter_pool_comm)
CALL mp_bcast(lwinq_big, ionode_id, inter_pool_comm)
CALL mp_bcast(exband, ionode_id, inter_pool_comm)
CALL mp_bcast(w_centers, ionode_id, inter_pool_comm)
!
CALL ckbounds(ik_start, ik_stop)
IF ( (ik_stop-ik_start+1) .ne. nks) CALL errore('loadumat',"Improper parallel ukk load",1)
......
......@@ -551,9 +551,6 @@ readwfc.o : ../../Modules/kind.o
readwfc.o : ../../Modules/mp_global.o
readwfc.o : ../../Modules/noncol.o
readwfc.o : ../../PW/src/pwcom.o
refold.o : ../../Modules/io_global.o
refold.o : io_epw.o
refold.o : kfold.o
rgd_blk_epw_fine_mem.o : ../../Modules/cell_base.o
rgd_blk_epw_fine_mem.o : ../../Modules/ions_base.o
rgd_blk_epw_fine_mem.o : ../../Modules/kind.o
......@@ -634,9 +631,6 @@ setphases_wrap.o : ../../Modules/mp_global.o
setphases_wrap.o : ../../PW/src/pwcom.o
setphases_wrap.o : ../../UtilXlib/mp.o
setphases_wrap.o : elph2.o
sgama2.o : ../../Modules/constants.o
sgama2.o : ../../Modules/io_global.o
sgama2.o : ../../Modules/kind.o
sort.o : ../../Modules/kind.o
spectral_cumulant.o : ../../FFTXlib/fft_scalar.o
spectral_cumulant.o : ../../Modules/io_global.o
......
......@@ -1704,7 +1704,9 @@ SUBROUTINE write_filukk
!
! Now write the Wannier centers to files
DO iw = 1, n_wannier
WRITE (iuukk,'(3f12.8)') wann_centers(:,iw)/alat/bohr
! SP : Need more precision other WS are not determined properly.
!WRITE (iuukk,'(3f12.8)') wann_centers(:,iw)/alat/bohr
WRITE (iuukk,'(3E22.12)') wann_centers(:,iw)/alat/bohr
ENDDO
!
CLOSE (iuukk)
......
!
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
! Copyright (C) 2007-2009 Jesse Noffsinger, Brad Malone, Feliciano Giustino
!
! This file is distributed under the terms of the GNU General Public
! License. See the file `LICENSE' in the root directory of the
! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
!
!
!-----------------------------------------------------------------------
SUBROUTINE refold( ngm_g, mill_g, itoj, jtoi )
!----------------------------------------------------------------------
!
! Map the indices of G+G_0 into those of G
! this is used to calculate electron-phonon matrix elements by
! refolding the k+q points into the first BZ (original k grid)
!
! No parallelization on G-vecs at the moment
! (actually this is done on the global array, but in elphel2.f90
! every processor has just a chunk of the array, I may need some
! communication)
!
! No ultrasoft now
!
! I use the rule : if not found then gmap = 0
! Note that the map will be used only up to npwx (small sphere),
! while the G-vectors lost in the process are on the surface of
! the large sphere (density set).
!
!-----------------------------------------------------------------
USE io_global, ONLY : stdout, meta_ionode
USE io_epw, ONLY : iukgmap
! SP: Sucidal. Produce too much data. Only use for debugging.
! USE control_flags, ONLY : iverbosity
USE kfold
!
IMPLICIT NONE
!
INTEGER :: ngm_g
!! Counter on G-vectors
INTEGER :: mill_g(3,ngm_g)
!! Array of Miller indices of G-vectors in increasing order of G^2
INTEGER :: jtoi(ngm_g)
!! For the i-th G-vector in the sorted list, jtoi(i)
!! returns its index in the unsorted list
INTEGER :: itoj(ngm_g)
!! itoj(i) returns the index of the G-vector in the sorted list
!! that was at i-th position in the unsorted list
INTEGER :: ig0
!! Counter on G_0 vectors
INTEGER :: ig1, ig2
!! Counter on G vectors
INTEGER :: i, j, k
!! Miller indices for G+G_0 vector
INTEGER :: ig1_use, ig2_use, ig2_guess, notfound, guess_skip
!! Temporary G-vectors indices
INTEGER :: indold, indnew
!! Counter on G_0 vectors Indices for writing to file
!
LOGICAL :: tfound
!
!
ALLOCATE( gmap(ngm_g,ng0vec) )
gmap(:,:) = 0
guess_skip = 0
!
! Loop on the inequivalent G_0 vectors
!
DO ig0 = 1, ng0vec
!
IF (ig0 .eq. 1) THEN
WRITE(stdout,'(/5x,"Progress kgmap: ")',advance='no')
indold = 0
ENDIF
indnew = nint( dble(ig0) / dble(ng0vec) * 40 )
IF (indnew.ne.indold) WRITE(stdout,'(a)',advance='no') '#'
indold = indnew
!
!
!
notfound = 0
DO ig1 = 1, ngm_g
!
ig1_use = itoj(ig1)
!
! the initial G vector
!
i = mill_g(1,ig1_use)
j = mill_g(2,ig1_use)
k = mill_g(3,ig1_use)
!
! the final G+G_0 vector
!
i = i + g0vec_all(1,ig0)
j = j + g0vec_all(2,ig0)
k = k + g0vec_all(3,ig0)
!
ig2 = 0
tfound = .false.
!
! try to guess next index
!
ig2_guess = jtoi(ig1_use) + guess_skip
!
IF ((ig2_guess .gt. 0) .AND. (ig2_guess .lt. ngm_g+1)) THEN
!
ig2_guess = itoj(ig2_guess)
!
IF ((i .eq. mill_g(1,ig2_guess)) .AND. (j .eq. mill_g(2,ig2_guess)) .AND. (k .eq. mill_g(3,ig2_guess))) THEN
!
ig2_use = ig2_guess
tfound = .true.
!
ENDIF
!
ENDIF
!
DO WHILE ((.not. tfound) .AND. (ig2 .lt. ngm_g))
!
ig2 = ig2 + 1
ig2_use = itoj(ig2)
tfound = (i .eq. mill_g(1,ig2_use)) .AND. &
(j .eq. mill_g(2,ig2_use)) .AND. &
(k .eq. mill_g(3,ig2_use))
!
ENDDO
!
IF (tfound) THEN
gmap(ig1_use,ig0) = ig2_use
guess_skip = jtoi(ig2_use) - jtoi(ig1_use)
ELSE
gmap(ig1_use,ig0) = 0
notfound = notfound + 1
ENDIF
!
ENDDO
!
ENDDO
!
! output on file for electron-phonon matrix elements
!
IF (.NOT. meta_ionode) iukgmap = stdout
!
DO ig1 = 1, ngm_g
WRITE(iukgmap,'(9i10)') (gmap(ig1,ig0), ig0 = 1, ng0vec)
ENDDO
!
IF (iukgmap .ne. stdout) CLOSE(iukgmap)
WRITE(stdout,*)
!
end subroutine refold
This diff is collapsed.
......@@ -20,7 +20,7 @@
irvec_k, irvec_q, irvec_g, &
ndegen_k, ndegen_q, ndegen_g, &
wslen_k, wslen_q, wslen_g, &
w_centers, dims, tau, nat )
w_centers, dims, tau, dims2 )
!-----------------------------------------------------------------
!!
!! June 2018 - SP - CV
......@@ -73,7 +73,7 @@
!! size of the uniform q mesh
INTEGER, INTENT (in) :: dims
!! Number of bands in the Wannier space
INTEGER, INTENT (in) :: nat
INTEGER, INTENT (in) :: dims2
!! Number of atoms
INTEGER, ALLOCATABLE, INTENT (out) :: irvec_k(:,:)
!! integer components of the ir-th Wigner-Seitz grid point in the basis
......@@ -98,7 +98,7 @@
!! real-space length for electron-phonons, in units of alat
REAL(kind=DP), INTENT(in) :: w_centers(3,dims)
!! Wannier centers used for the creation of electron and el-ph WS cells
REAL(kind=DP), INTENT(in) :: tau(3,dims)
REAL(kind=DP), INTENT(in) :: tau(3,dims2)
!! Atomic position in the unit cell.
!
! Work Variables
......@@ -120,9 +120,9 @@
!! We use nk1 instead of nq1 because the k-grid is always larger or equal to q-grid.
INTEGER :: ndegen_kk (20*nk1*nk2*nk3, dims, dims)
!! local Wigner-Seitz number of degenerescence (weights) for the electrons grid
INTEGER :: ndegen_qq (20*nq1*nq2*nq3, nat, nat)
INTEGER :: ndegen_qq (20*nq1*nq2*nq3, dims2, dims2)
!! local Wigner-Seitz number of degenerescence (weights) for the phonons grid
INTEGER :: ndegen_gg (20*nq1*nq2*nq3, nat, dims, dims)
INTEGER :: ndegen_gg (20*nq1*nq2*nq3, dims2, dims, dims)
!! local Wigner-Seitz number of degenerescence (weights) for the electron-phonons grid
REAL(kind=DP) :: wslen_kk (20*nk1*nk2*nk3)
!! local real-space length for electrons, in units of alat
......@@ -139,15 +139,15 @@
!
! If dims > 1, it includes the position of Wannier-Centers
CALL wigner_seitzkq ( nk1, nk2, nk3, irvec_kk, ndegen_kk, wslen_kk, nrr_k, w_centers, dims)
CALL wigner_seitzkq ( nq1, nq2, nq3, irvec_qq, ndegen_qq, wslen_qq, nrr_q, tau, nat)
CALL wigner_seitzg ( nq1, nq2, nq3, irvec_gg, ndegen_gg, wslen_gg, nrr_g, w_centers, tau, dims, nat)
CALL wigner_seitzkq ( nq1, nq2, nq3, irvec_qq, ndegen_qq, wslen_qq, nrr_q, tau, dims2)
CALL wigner_seitzg ( nq1, nq2, nq3, irvec_gg, ndegen_gg, wslen_gg, nrr_g, w_centers, tau, dims, dims2)
!
ALLOCATE ( irvec_k(3,nrr_k) )
ALLOCATE ( irvec_q(3,nrr_q) )
ALLOCATE ( irvec_g(3,nrr_g) )
ALLOCATE ( ndegen_k(nrr_k, dims, dims) )
ALLOCATE ( ndegen_q(nrr_q, nat, nat) )
ALLOCATE ( ndegen_g(nrr_g, nat, dims, dims) )
ALLOCATE ( ndegen_q(nrr_q, dims2, dims2) )
ALLOCATE ( ndegen_g(nrr_g, dims2, dims, dims) )
ALLOCATE ( wslen_k(nrr_k) )
ALLOCATE ( wslen_q(nrr_q) )
ALLOCATE ( wslen_g(nrr_g) )
......@@ -185,7 +185,7 @@
!-----------------------------------------------------------------
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE constants_epw, ONLY : eps8
USE constants_epw, ONLY : eps6
!
implicit none
!
......@@ -291,7 +291,7 @@
!
! Sort the 125 vectors R by increasing value of |r-R|^2
ind(1) = 0 ! required for hpsort_eps (see the subroutine)
CALL hpsort_eps_epw( 125, dist, ind, eps8)
CALL hpsort_eps_epw( 125, dist, ind, eps6)
!
! Find all the vectors R with the (same) smallest |r-R|^2;
! if R=0 is one of them, then the current point r belongs to
......@@ -300,7 +300,7 @@
found = .false.
i = 1
mindist = dist(1)
DO WHILE ( abs(dist(i)-mindist) < eps8 .and. i < 125 )
DO WHILE ( abs(dist(i)-mindist) < eps6 .and. i < 125 )
IF (ind(i) == 63) found = .true.
i = i + 1
ENDDO
......@@ -366,9 +366,9 @@
ENDDO
!
!print*,'na, nb, tot tot2 ',na,nb,tot,tot2,nq1,nq2,nq3,dble(nq1*nq2*nq3)
IF(abs(tot-dble(nc1*nc2*nc3)) > eps8) call errore &
IF(abs(tot-dble(nc1*nc2*nc3)) > eps6) call errore &
('wigner_seitzkq',' weights do not add up to nc1*nc2*nc3',1)
IF(abs(tot-tot2) > eps8) call errore &
IF(abs(tot-tot2) > eps6) call errore &
('wigner_seitzkq',' weigths of pair of atoms is not equal to global weights',1)
ENDDO
ENDDO
......@@ -404,7 +404,7 @@
!-----------------------------------------------------------------------------
!
!-----------------------------------------------------------------
SUBROUTINE wigner_seitzg (nc1, nc2, nc3, irvec, ndegen, wslen, nrr, w_centers, tau, dims, nat)
SUBROUTINE wigner_seitzg (nc1, nc2, nc3, irvec, ndegen, wslen, nrr, w_centers, tau, dims, dims2)
!-----------------------------------------------------------------
!!
!! Calculates a grid of points that fall inside of (and eventually
......@@ -417,7 +417,7 @@
!-----------------------------------------------------------------
USE kinds, ONLY : DP
USE cell_base, ONLY : at, bg
USE constants_epw, ONLY : eps8
USE constants_epw, ONLY : eps6
!
implicit none
!
......@@ -429,17 +429,17 @@
!! size of the uniform k mesh
INTEGER, INTENT (in) :: dims
!! Dims is either nbndsub or 1 depending on use_ws
INTEGER, INTENT (in) :: nat
INTEGER, INTENT (in) :: dims2
!! Number of atoms
INTEGER, INTENT (out) :: irvec(3,20*nc1*nc2*nc3)
!! integer components of the ir-th Wigner-Seitz grid point in the basis of the lattice vectors
INTEGER, INTENT (out) :: ndegen(20*nc1*nc2*nc3,nat,dims,dims)
INTEGER, INTENT (out) :: ndegen(20*nc1*nc2*nc3,dims2,dims,dims)
!! Number of degeneracies
INTEGER, INTENT (out) :: nrr
!! number of Wigner-Seitz grid points
REAL(kind=DP), INTENT (in) :: w_centers(3,dims)
!! Wannier centers
REAL(kind=DP), INTENT (in) :: tau(3,nat)
REAL(kind=DP), INTENT (in) :: tau(3,dims2)
!! Atomic positions
REAL(kind=DP), INTENT (out) :: wslen(20*nc1*nc2*nc3)
!! real-space length, in units of alat
......@@ -463,12 +463,12 @@
!! Index of sorting
INTEGER :: nind
!! The metric tensor
INTEGER :: nrr_tmp(nat,dims,dims)
INTEGER :: nrr_tmp(dims2,dims,dims)
!! Temporary array that contains the max number of WS vectors