1!
2! Copyright (C) 20102011 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!=----------------------------------------------------------------------------=!
9   MODULE smallbox_gvec
10!=----------------------------------------------------------------------------=!
11     USE kinds, ONLY: DP
12
13     IMPLICIT NONE
14     SAVE
15
16     ! ...   Variables describing G-vectors for the small box grid
17     ! ...   Basically the same meaning as for the corresponding
18     ! ...   quantities for the true lattice
19     !
20     INTEGER :: ngb  = 0  ! local number of G vectors
21     INTEGER :: ngbl = 0  ! number of G-vector shells up to ngw
22
23     REAL(DP), ALLOCATABLE :: gb(:)    ! G(i)^2 in (tpi/alatb)**2 units
24     REAL(DP), ALLOCATABLE :: gxb(:,:) ! G(:,i) in  tpi/alatb     units
25     REAL(DP), ALLOCATABLE :: glb(:)   ! shells of G(i)^2
26     INTEGER, ALLOCATABLE :: npb(:), nmb(:) ! FFT indices
27     INTEGER, ALLOCATABLE :: mill_b(:,:)    ! miller indices
28
29     REAL(DP) :: gcutb = 0.0_DP  ! effective cut-off in (tpi/alatb)**2 units
30
31   CONTAINS
32
33     SUBROUTINE deallocate_smallbox_gvec()
34       IF( ALLOCATED( gb ) ) DEALLOCATE( gb )
35       IF( ALLOCATED( gxb ) ) DEALLOCATE( gxb )
36       IF( ALLOCATED( glb ) ) DEALLOCATE( glb )
37       IF( ALLOCATED( npb ) ) DEALLOCATE( npb )
38       IF( ALLOCATED( nmb ) ) DEALLOCATE( nmb )
39       IF( ALLOCATED( mill_b ) ) DEALLOCATE( mill_b )
40     END SUBROUTINE deallocate_smallbox_gvec
41
42!=----------------------------------------------------------------------------=!
43   END MODULE smallbox_gvec
44!=----------------------------------------------------------------------------=!
45