mirror of https://gitlab.com/QEF/q-e.git
92 lines
3.1 KiB
Fortran
92 lines
3.1 KiB
Fortran
SUBROUTINE generate_k_along_lines(nkaux, xkaux, wkaux, xk, wk, nkstot)
|
|
!
|
|
!! This routine recieves as input a set of k point (\(\text{xkaux}\)) and
|
|
!! integer weights (\(\text{wkaux}\)) and generates a set of k points along
|
|
!! the lines \(\text{xkaux}(:,i+1)-\text{xkaux}(:,i)\). Each line contains
|
|
!! \(\text{wkaux}(i)\) points.
|
|
!! The weights of each k point \(\text{wk}(i)\) is the length of the path
|
|
!! from \(\text{xk}(:,1)\) to \(\text{xk}(i)\). Points with \(\text{wkaux}=0\)
|
|
!! do not increase the path length.
|
|
!! The total number of output points must be \(\text{nkstot}\), and \(\text{xk}\)
|
|
!! and \(\text{wk}\) must be array of length \(\text{nkstot}\).
|
|
!
|
|
USE kinds, ONLY : DP
|
|
IMPLICIT NONE
|
|
|
|
INTEGER, INTENT(IN) :: nkaux, nkstot, wkaux(nkaux)
|
|
REAL(DP), INTENT(IN) :: xkaux(3,nkaux)
|
|
REAL(DP), INTENT(OUT) :: xk(3,nkstot), wk(nkstot)
|
|
|
|
INTEGER :: nkstot_, i, j
|
|
REAL(DP) :: delta, xkmod
|
|
|
|
nkstot_=1
|
|
wk(1)=0.0_DP
|
|
xk(:,1)=xkaux(:,1)
|
|
DO i=2,nkaux
|
|
IF (wkaux(i-1)>0) THEN
|
|
delta=1.0_DP/wkaux(i-1)
|
|
DO j=1,wkaux(i-1)
|
|
nkstot_=nkstot_+1
|
|
IF (nkstot_ > nkstot) CALL errore ('generate_k_along_lines', &
|
|
'internal error 1: wrong nkstot',i)
|
|
xk(:,nkstot_)=xkaux(:,i-1)+delta*j*(xkaux(:,i)-xkaux(:,i-1))
|
|
xkmod=SQRT( (xk(1,nkstot_)-xk(1,nkstot_-1))**2 + &
|
|
(xk(2,nkstot_)-xk(2,nkstot_-1))**2 + &
|
|
(xk(3,nkstot_)-xk(3,nkstot_-1))**2 )
|
|
wk(nkstot_)=wk(nkstot_-1) + xkmod
|
|
ENDDO
|
|
ELSEIF (wkaux(i-1)==0) THEN
|
|
nkstot_=nkstot_+1
|
|
IF (nkstot_ > nkstot) CALL errore ('generate_k_along_lines', &
|
|
'internal error 2: wrong nkstot',i)
|
|
IF (nkstot_ ==1 ) CALL errore ('generate_k_along_lines', &
|
|
'problems with weights',i)
|
|
xk(:,nkstot_)=xkaux(:,i)
|
|
wk(nkstot_)=wk(nkstot_-1)
|
|
ELSE
|
|
CALL errore ('generate_k_along_lines', 'wrong number of points',i)
|
|
ENDIF
|
|
ENDDO
|
|
IF (nkstot_ /= nkstot) CALL errore ('generate_k_along_lines', &
|
|
'internal error 3: wrong nkstot',nkstot_)
|
|
|
|
RETURN
|
|
END SUBROUTINE generate_k_along_lines
|
|
|
|
SUBROUTINE generate_k_in_plane(nkaux, xkaux, wkaux, xk, wk, nkstot)
|
|
!! Generate a uniform mesh of k points on the plane defined by
|
|
!! the origin xkaux(:,1), and two vectors \(\text{xkaux}(:,2)\)
|
|
!! and \(\text{xkaux}(:,3)\).
|
|
!! The size of the mesh is \(\text{wkaux}(2)\cdot\text{wkaux}(3)\).
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
|
IMPLICIT NONE
|
|
|
|
INTEGER, INTENT(IN) :: nkaux, nkstot, wkaux(nkaux)
|
|
REAL(DP), INTENT(IN) :: xkaux(3,nkaux)
|
|
REAL(DP), INTENT(OUT) :: xk(3,nkstot), wk(nkstot)
|
|
|
|
REAL(DP) :: dkx(3), dky(3), wk0
|
|
INTEGER :: ijk, i, j
|
|
|
|
dkx(:)=(xkaux(:,2)-xkaux(:,1))/(wkaux(2)-1.0_DP)
|
|
dky(:)=(xkaux(:,3)-xkaux(:,1))/(wkaux(3)-1.0_DP)
|
|
wk0=1.0_DP/nkstot
|
|
ijk=0
|
|
DO i=1, wkaux(2)
|
|
DO j = 1, wkaux(3)
|
|
ijk=ijk+1
|
|
IF (ijk > nkstot) CALL errore ('generate_k_in_plane', &
|
|
'internal error : wrong nstot',i)
|
|
|
|
xk(:,ijk) = xkaux(:,1) + dkx(:)*(i-1) + dky(:) * (j-1)
|
|
wk(ijk) = wk0
|
|
ENDDO
|
|
ENDDO
|
|
|
|
RETURN
|
|
|
|
END SUBROUTINE generate_k_in_plane
|