2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
! Copyright (C) 2001-2003 PWSCF group
|
2003-01-20 05:58:50 +08:00
|
|
|
! 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 .
|
|
|
|
|
!
|
|
|
|
|
!
|
2003-06-25 20:43:25 +08:00
|
|
|
!-------------------------------------------------------------------------
|
2003-07-09 17:06:23 +08:00
|
|
|
subroutine latgen(ibrav,celldm,a1,a2,a3,omega)
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
|
! sets up the crystallographic vectors a1, a2, and a3.
|
|
|
|
|
!
|
|
|
|
|
! ibrav is the structure index:
|
|
|
|
|
! 1 cubic p (sc) 8 orthorhombic p
|
|
|
|
|
! 2 cubic f (fcc) 9 one face centered orthorhombic
|
|
|
|
|
! 3 cubic i (bcc) 10 all face centered orthorhombic
|
|
|
|
|
! 4 hexagonal and trigonal p 11 body centered orthorhombic
|
|
|
|
|
! 5 trigonal r 12 monoclinic p
|
|
|
|
|
! 6 tetragonal p (st) 13 one face centered monoclinic
|
|
|
|
|
! 7 tetragonal i (bct) 14 triclinic p
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
! celldm are parameters which fix the shape of the unit cell
|
|
|
|
|
! omega is the unit-cell volume
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
! NOTA BENE: all axis sets are right-handed
|
|
|
|
|
! Boxes for US PPs do not work properly with left-handed axis
|
|
|
|
|
!
|
2004-01-23 23:08:03 +08:00
|
|
|
use kinds, only: DP
|
2003-02-08 00:04:36 +08:00
|
|
|
implicit none
|
2005-10-12 23:52:03 +08:00
|
|
|
integer, intent(in) :: ibrav
|
2005-12-02 22:51:57 +08:00
|
|
|
real(DP), intent(inout) :: celldm(6)
|
2005-10-12 23:52:03 +08:00
|
|
|
real(DP), intent(inout) :: a1(3), a2(3), a3(3)
|
|
|
|
|
real(DP), intent(out) :: omega
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2005-08-28 22:09:42 +08:00
|
|
|
real(DP), parameter:: sr2 = 1.414213562373d0, &
|
2005-10-12 23:52:03 +08:00
|
|
|
sr3 = 1.732050807569d0
|
|
|
|
|
integer :: i,j,k,l,iperm,ir
|
|
|
|
|
real(DP) :: term, cbya, s, term1, term2, singam, sen
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2005-12-02 22:51:57 +08:00
|
|
|
! user-supplied lattice vectors
|
|
|
|
|
!
|
|
|
|
|
if (ibrav == 0) then
|
|
|
|
|
if (SQRT( a1(1)**2 + a1(2)**2 + a1(3)**2 ) == 0 ) &
|
|
|
|
|
call errore ('latgen', 'wrong at for ibrav=0', 1)
|
|
|
|
|
if (SQRT( a2(1)**2 + a2(2)**2 + a2(3)**2 ) == 0 ) &
|
|
|
|
|
call errore ('latgen', 'wrong at for ibrav=0', 2)
|
|
|
|
|
if (SQRT( a3(1)**2 + a3(2)**2 + a3(3)**2 ) == 0 ) &
|
|
|
|
|
call errore ('latgen', 'wrong at for ibrav=0', 3)
|
|
|
|
|
|
|
|
|
|
if ( celldm(1) /= 0.D0 ) then
|
|
|
|
|
!
|
|
|
|
|
! ... input at are in units of alat => convert them to a.u.
|
|
|
|
|
!
|
|
|
|
|
a1(:) = a1(:) * celldm(1)
|
|
|
|
|
a2(:) = a2(:) * celldm(1)
|
|
|
|
|
a3(:) = a3(:) * celldm(1)
|
|
|
|
|
else
|
|
|
|
|
!
|
|
|
|
|
! ... input at are in atomic units: define celldm(1) from a1
|
|
|
|
|
!
|
|
|
|
|
celldm(1) = SQRT( a1(1)**2 + a1(2)**2 + a1(3)**2 )
|
|
|
|
|
end if
|
|
|
|
|
!
|
|
|
|
|
else
|
|
|
|
|
a1(:) = 0.d0
|
|
|
|
|
a2(:) = 0.d0
|
|
|
|
|
a3(:) = 0.d0
|
|
|
|
|
end if
|
2005-10-12 23:52:03 +08:00
|
|
|
!
|
2005-12-02 22:51:57 +08:00
|
|
|
if (celldm (1) <= 0.d0) call errore ('latgen', 'wrong celldm(1)', ibrav)
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
2005-12-03 00:16:51 +08:00
|
|
|
! index of bravais lattice supplied
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
if (ibrav == 1) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! simple cubic lattice
|
|
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(2)=celldm(1)
|
|
|
|
|
a3(3)=celldm(1)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 2) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! fcc lattice
|
|
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
term=celldm(1)/2.d0
|
|
|
|
|
a1(1)=-term
|
|
|
|
|
a1(3)=term
|
|
|
|
|
a2(2)=term
|
|
|
|
|
a2(3)=term
|
|
|
|
|
a3(1)=-term
|
|
|
|
|
a3(2)=term
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 3) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! bcc lattice
|
|
|
|
|
!
|
2003-07-09 17:06:23 +08:00
|
|
|
term=celldm(1)/2.d0
|
|
|
|
|
do ir=1,3
|
|
|
|
|
a1(ir)=term
|
|
|
|
|
a2(ir)=term
|
|
|
|
|
a3(ir)=term
|
|
|
|
|
end do
|
|
|
|
|
a2(1)=-term
|
|
|
|
|
a3(1)=-term
|
|
|
|
|
a3(2)=-term
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
else if (ibrav == 4) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! hexagonal lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
cbya=celldm(3)
|
|
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(1)=-celldm(1)/2.d0
|
|
|
|
|
a2(2)=celldm(1)*sr3/2.d0
|
|
|
|
|
a3(3)=celldm(1)*cbya
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 5) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! trigonal lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (4) <= -0.5d0 .or. celldm (4) >= 1) &
|
|
|
|
|
call errore ('latgen', 'wrong celldm(4)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
term1=sqrt(1.d0+2.d0*celldm(4))
|
|
|
|
|
term2=sqrt(1.d0-celldm(4))
|
|
|
|
|
a2(2)=sr2*celldm(1)*term2/sr3
|
|
|
|
|
a2(3)=celldm(1)*term1/sr3
|
|
|
|
|
a1(1)=celldm(1)*term2/sr2
|
|
|
|
|
a1(2)=-a1(1)/sr3
|
|
|
|
|
a1(3)= a2(3)
|
|
|
|
|
a3(1)=-a1(1)
|
|
|
|
|
a3(2)= a1(2)
|
|
|
|
|
a3(3)= a2(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 6) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! tetragonal lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
cbya=celldm(3)
|
|
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(2)=celldm(1)
|
|
|
|
|
a3(3)=celldm(1)*cbya
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 7) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! body centered tetragonal lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
cbya=celldm(3)
|
|
|
|
|
a2(1)=celldm(1)/2.d0
|
|
|
|
|
a2(2)=a2(1)
|
|
|
|
|
a2(3)=cbya*celldm(1)/2.d0
|
|
|
|
|
a1(1)= a2(1)
|
|
|
|
|
a1(2)=-a2(1)
|
|
|
|
|
a1(3)= a2(3)
|
|
|
|
|
a3(1)=-a2(1)
|
|
|
|
|
a3(2)=-a2(1)
|
|
|
|
|
a3(3)= a2(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 8) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Simple orthorhombic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(2)=celldm(1)*celldm(2)
|
|
|
|
|
a3(3)=celldm(1)*celldm(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 9) then
|
|
|
|
|
!
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! One face centered orthorhombic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
2006-12-14 16:53:47 +08:00
|
|
|
a1(1) = 0.5d0 * celldm(1)
|
2003-07-09 17:06:23 +08:00
|
|
|
a1(2) = a1(1) * celldm(2)
|
|
|
|
|
a2(1) = - a1(1)
|
|
|
|
|
a2(2) = a1(2)
|
|
|
|
|
a3(3) = celldm(1) * celldm(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 10) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! All face centered orthorhombic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
2006-12-14 16:53:47 +08:00
|
|
|
a2(1) = 0.5d0 * celldm(1)
|
2003-07-09 17:06:23 +08:00
|
|
|
a2(2) = a2(1) * celldm(2)
|
|
|
|
|
a1(1) = a2(1)
|
|
|
|
|
a1(3) = a2(1) * celldm(3)
|
|
|
|
|
a3(2) = a2(1) * celldm(2)
|
|
|
|
|
a3(3) = a1(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 11) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Body centered orthorhombic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
2006-12-14 16:53:47 +08:00
|
|
|
a1(1) = 0.5d0 * celldm(1)
|
2003-07-09 17:06:23 +08:00
|
|
|
a1(2) = a1(1) * celldm(2)
|
|
|
|
|
a1(3) = a1(1) * celldm(3)
|
|
|
|
|
a2(1) = - a1(1)
|
|
|
|
|
a2(2) = a1(2)
|
|
|
|
|
a2(3) = a1(3)
|
|
|
|
|
a3(1) = - a1(1)
|
|
|
|
|
a3(2) = - a1(2)
|
|
|
|
|
a3(3) = a1(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 12) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Simple monoclinic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
|
|
|
|
if (abs(celldm(4))>=1.d0) call errore ('latgen', 'wrong celldm(4)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
sen=sqrt(1.d0-celldm(4)**2)
|
|
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(1)=celldm(1)*celldm(2)*celldm(4)
|
|
|
|
|
a2(2)=celldm(1)*celldm(2)*sen
|
|
|
|
|
a3(3)=celldm(1)*celldm(3)
|
|
|
|
|
!
|
|
|
|
|
else if (ibrav == 13) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! One face centered monoclinic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
|
|
|
|
if (abs(celldm(4))>=1.d0) call errore ('latgen', 'wrong celldm(4)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
sen = sqrt( 1.d0 - celldm(4) ** 2 )
|
2006-12-14 16:53:47 +08:00
|
|
|
a1(1) = 0.5d0 * celldm(1)
|
2006-10-19 00:34:22 +08:00
|
|
|
a1(3) =-a1(1) * celldm(3)
|
|
|
|
|
a2(1) = celldm(1) * celldm(2) * celldm(4)
|
|
|
|
|
a2(2) = celldm(1) * celldm(2) * sen
|
|
|
|
|
a3(1) = a1(1)
|
|
|
|
|
a3(3) =-a1(3)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
else if (ibrav == 14) then
|
2003-01-20 05:58:50 +08:00
|
|
|
!
|
|
|
|
|
! Triclinic lattice
|
|
|
|
|
!
|
2005-10-12 23:52:03 +08:00
|
|
|
if (celldm (2) <= 0.d0) call errore ('latgen', 'wrong celldm(2)', ibrav)
|
|
|
|
|
if (celldm (3) <= 0.d0) call errore ('latgen', 'wrong celldm(3)', ibrav)
|
|
|
|
|
if (abs(celldm(4))>=1.d0) call errore ('latgen', 'wrong celldm(4)', ibrav)
|
|
|
|
|
if (abs(celldm(5))>=1.d0) call errore ('latgen', 'wrong celldm(5)', ibrav)
|
|
|
|
|
if (abs(celldm(6))>=1.d0) call errore ('latgen', 'wrong celldm(6)', ibrav)
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
singam=sqrt(1.d0-celldm(6)**2)
|
2008-07-22 17:32:29 +08:00
|
|
|
term= (1.d0+2.d0*celldm(4)*celldm(5)*celldm(6) &
|
|
|
|
|
-celldm(4)**2-celldm(5)**2-celldm(6)**2)
|
|
|
|
|
if (term < 0.d0) call errore &
|
|
|
|
|
('latgen', 'celldm do not make sense, check your data', ibrav)
|
|
|
|
|
term= sqrt(term/(1.d0-celldm(6)**2))
|
2003-07-09 17:06:23 +08:00
|
|
|
a1(1)=celldm(1)
|
|
|
|
|
a2(1)=celldm(1)*celldm(2)*celldm(6)
|
|
|
|
|
a2(2)=celldm(1)*celldm(2)*singam
|
|
|
|
|
a3(1)=celldm(1)*celldm(3)*celldm(5)
|
|
|
|
|
a3(2)=celldm(1)*celldm(3)*(celldm(4)-celldm(5)*celldm(6))/singam
|
|
|
|
|
a3(3)=celldm(1)*celldm(3)*term
|
|
|
|
|
!
|
2003-02-08 00:04:36 +08:00
|
|
|
else
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
call errore('latgen',' nonexistent bravais lattice',ibrav)
|
|
|
|
|
!
|
|
|
|
|
end if
|
|
|
|
|
!
|
|
|
|
|
! calculate unit-cell volume omega
|
|
|
|
|
!
|
|
|
|
|
100 omega=0.d0
|
|
|
|
|
s=1.d0
|
|
|
|
|
i=1
|
|
|
|
|
j=2
|
|
|
|
|
k=3
|
|
|
|
|
!
|
|
|
|
|
101 do iperm=1,3
|
|
|
|
|
omega=omega+s*a1(i)*a2(j)*a3(k)
|
|
|
|
|
l=i
|
|
|
|
|
i=j
|
|
|
|
|
j=k
|
|
|
|
|
k=l
|
|
|
|
|
end do
|
|
|
|
|
!
|
|
|
|
|
i=2
|
|
|
|
|
j=1
|
|
|
|
|
k=3
|
|
|
|
|
s=-s
|
|
|
|
|
if(s < 0.d0) go to 101
|
|
|
|
|
omega=abs(omega)
|
2003-02-08 00:04:36 +08:00
|
|
|
return
|
2003-07-09 17:06:23 +08:00
|
|
|
!
|
|
|
|
|
end subroutine latgen
|
