mirror of https://gitlab.com/QEF/q-e.git
68 lines
1.7 KiB
Fortran
68 lines
1.7 KiB
Fortran
SUBROUTINE recips (a1, a2, a3, b1, b2, b3)
|
|
!---------------------------------------------------------------------
|
|
!
|
|
! This routine generates the reciprocal lattice vectors b1,b2,b3
|
|
! given the real space vectors a1,a2,a3. The b's are units of 2 pi/a.
|
|
!
|
|
! first the input variables
|
|
!
|
|
USE fft_param, ONLY : DP
|
|
implicit none
|
|
real(DP) :: a1 (3), a2 (3), a3 (3), b1 (3), b2 (3), b3 (3)
|
|
! input: first direct lattice vector
|
|
! input: second direct lattice vector
|
|
! input: third direct lattice vector
|
|
! output: first reciprocal lattice vector
|
|
! output: second reciprocal lattice vector
|
|
! output: third reciprocal lattice vector
|
|
!
|
|
! then the local variables
|
|
!
|
|
real(DP) :: den, s
|
|
! the denominator
|
|
! the sign of the permutations
|
|
integer :: iperm, i, j, k, l, ipol
|
|
! counter on the permutations
|
|
!\
|
|
! Auxiliary variables
|
|
!/
|
|
!
|
|
! Counter on the polarizations
|
|
!
|
|
! first we compute the denominator
|
|
!
|
|
den = 0
|
|
i = 1
|
|
j = 2
|
|
k = 3
|
|
s = 1.d0
|
|
100 do iperm = 1, 3
|
|
den = den + s * a1 (i) * a2 (j) * a3 (k)
|
|
l = i
|
|
i = j
|
|
j = k
|
|
k = l
|
|
enddo
|
|
i = 2
|
|
j = 1
|
|
k = 3
|
|
s = - s
|
|
if (s.lt.0.d0) goto 100
|
|
!
|
|
! here we compute the reciprocal vectors
|
|
!
|
|
i = 1
|
|
j = 2
|
|
k = 3
|
|
do ipol = 1, 3
|
|
b1 (ipol) = (a2 (j) * a3 (k) - a2 (k) * a3 (j) ) / den
|
|
b2 (ipol) = (a3 (j) * a1 (k) - a3 (k) * a1 (j) ) / den
|
|
b3 (ipol) = (a1 (j) * a2 (k) - a1 (k) * a2 (j) ) / den
|
|
l = i
|
|
i = j
|
|
j = k
|
|
k = l
|
|
enddo
|
|
return
|
|
end subroutine recips
|