1!
2! Copyright (C) 1996-2016	The SIESTA group
3!  This file is distributed under the terms of the
4!  GNU General Public License: see COPYING in the top directory
5!  or http://www.gnu.org/copyleft/gpl.txt.
6! See Docs/Contributors.txt for a list of contributors.
7!
8! This code segment has been fully created by:
9! Nick Papior Andersen, 2012, nickpapior@gmail.com
10!
11subroutine kpoint_convert(ucell,kin,kout,iopt)
12! **********************************************************************
13! Enables the conversion between Fourier space k-points into reciprocal
14! space k-points.
15! Created by Nick Papior Andersen, Aug. 2012
16! Modified by Nick Papior Andersen, Jan. 2015
17! ***************** INPUT **********************************************
18! real*8  ucell(3,3)  : Unit cell vectors in real space cell(ixyz,ivec)
19! real*8  kin(3)      : k-point in units of [b] or [1/Bohr]
20! integer iopt        : -2 => From units of [b] to [1/Bohr],
21!                             Here 'ucell' is the reciprocal cell with 2Pi
22!                             This can be obtained by:
23!                                'call reclat(cell,rcell,1)'
24!                     : -1 => From units of [b] to [1/Bohr]
25!                     :  1 => From units of [1/Bohr] to [b]
26! ***************** OUTPUT *********************************************
27! real*8  kout(3)     : k-point in units of [b] or [1/Bohr]
28!
29! Allows for conversion between units of reciprocal k-points.
30! **********************************************************************
31  use precision, only : dp
32  use units    , only : Pi
33  use sys      , only : die
34
35  real(dp), dimension(3,3), intent(in)  :: ucell
36  real(dp), dimension(3)  , intent(in)  :: kin
37  real(dp), dimension(3)  , intent(out) :: kout
38  integer                 , intent(in)  :: iopt
39
40! ***********************
41! * LOCAL variables     *
42! ***********************
43  real(dp), dimension(3,3) :: rcell
44
45  if ( iopt == 1 ) then
46     kout(1) = sum(ucell(:,1) * kin(:)) * 0.5_dp / Pi
47     kout(2) = sum(ucell(:,2) * kin(:)) * 0.5_dp / Pi
48     kout(3) = sum(ucell(:,3) * kin(:)) * 0.5_dp / Pi
49  else if ( iopt == -1 ) then
50     call reclat(ucell,rcell,1)
51     kout(1) = sum(rcell(1,:) * kin(:))
52     kout(2) = sum(rcell(2,:) * kin(:))
53     kout(3) = sum(rcell(3,:) * kin(:))
54  else if ( iopt == -2 ) then
55     kout(1) = sum(ucell(1,:) * kin(:))
56     kout(2) = sum(ucell(2,:) * kin(:))
57     kout(3) = sum(ucell(3,:) * kin(:))
58  else
59     call die("Wrong option for kpoint_convert! Only 1, -1 or -2 allowed.")
60  end if
61
62end subroutine kpoint_convert
63