1!
2! Copyright (C) 2011 Quantum ESPRESSO group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!--------------------------------------------------------------------------
9MODULE start_k
10  !--------------------------------------------------------------------------
11  !! Basic variables for k-point generations, as read from input.
12  !
13  USE kinds,      ONLY : DP
14  USE cell_base,  ONLY : bg
15  !
16  SAVE
17  !
18  ! ... uniform k-point grid parameters
19  !
20  INTEGER :: nk1
21  !! the special-point grid, direction 1
22  INTEGER :: nk2
23  !! the special-point grid, direction 2
24  INTEGER :: nk3
25  !! the special-point grid, direction 3
26  INTEGER :: k1
27  !! the offset from the origin, direction 1
28  INTEGER :: k2
29  !! the offset from the origin, direction 2
30  INTEGER :: k3
31  !! the offset from the origin, direction 3
32  !
33  ! ... k points and weights, read from input, if any
34  !
35  INTEGER :: nks_start=0
36  !! number of  k points
37  REAL(DP), ALLOCATABLE :: wk_start(:)
38  !! weights of k points
39  REAL(DP), ALLOCATABLE :: xk_start(:,:)
40  !! coordinates of k points
41  !
42  CONTAINS
43  !
44  !---------------------------------------------------------------------
45    SUBROUTINE init_start_k( nk1_, nk2_, nk3_, k1_, k2_, k3_, k_points, &
46                             nk_, xk_, wk_ )
47       !-------------------------------------------------------------------
48       !! Initialize the grid of k points. See module \(\textrm{start_k}\)
49       !! to know meaning of the variables.
50       !
51       INTEGER, INTENT(IN) :: nk1_, nk2_, nk3_, k1_, k2_, k3_, nk_
52       CHARACTER(LEN=*), INTENT(IN) :: k_points
53       REAL(DP), INTENT(INOUT) :: xk_(3,nk_)
54       REAL(DP), INTENT(IN) :: wk_(nk_)
55       !
56       LOGICAL :: done
57       !
58       ! variables for automatic grid
59       !
60       nk1 = 0; nk2 = 0; nk3 = 0; k1 = 0; k2 = 0; k3 = 0
61       done = reset_grid ( nk1_, nk2_, nk3_, k1_, k2_, k3_ )
62       IF ( k_points == 'automatic' .AND. .NOT. done ) &
63          CALL errore( 'init_start_k','automatic k-points and nk*=0?', 1 )
64       !
65       ! variables for manual grid
66       !
67       IF ( k_points == 'gamma' ) THEN
68          nks_start = 1
69       ELSE
70          nks_start = nk_
71       ENDIF
72       !
73       IF ( nks_start > 0) THEN
74          !
75          IF ( .NOT. ALLOCATED(xk_start) ) ALLOCATE( xk_start(3,nks_start) )
76          IF ( .NOT. ALLOCATED(wk_start) ) ALLOCATE( wk_start(nks_start) )
77          !
78          ! k-points in crystal axis: transform to cartesian (in units 2pi/a)
79          ! BEWARE: reciprocal axis bg NEEDED, must have been initialized
80          !
81          IF ( k_points == 'crystal' ) CALL cryst_to_cart( nk_, xk_, bg, 1 )
82          !
83          IF ( k_points == 'gamma' ) THEN
84            xk_start(:,1) = 0.0_dp
85            wk_start(1)   = 1.0_dp
86          ELSE
87            xk_start(:,:) = xk_(:,1:nk_)
88            wk_start(:)   = wk_(1:nk_)
89          ENDIF
90          !
91       ENDIF
92       !
93    END SUBROUTINE init_start_k
94    !
95    !---------------------------------------------------------------
96    LOGICAL FUNCTION reset_grid( nk1_, nk2_, nk3_, k1_, k2_, k3_ )
97       !-----------------------------------------------------------
98       !! Reset the automatic grid to new values if these are > 0.
99       !
100       INTEGER, INTENT(IN) :: nk1_, nk2_, nk3_, k1_, k2_, k3_
101       !
102       reset_grid = (nk1_*nk2_*nk3_ > 0)
103       IF ( .NOT. reset_grid ) RETURN
104       nk1 = nk1_
105       nk2 = nk2_
106       nk3 = nk3_
107       k1 = k1_
108       k2 = k2_
109       k3 = k3_
110       !
111    END FUNCTION reset_grid
112    !
113    !
114END MODULE start_k
115