1!
2! Copyright (C) 2010-2016 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 gvecw
10!=----------------------------------------------------------------------------=!
11     USE kinds, ONLY: DP
12
13     IMPLICIT NONE
14     SAVE
15
16     PRIVATE
17     PUBLIC :: ngw, ngw_g, ngwx, ecutwfc, gcutw, ekcut, gkcut
18     PUBLIC :: g2kin, ecfixed, qcutz, q2sigma
19     PUBLIC :: gvecw_init, g2kin_init, deallocate_gvecw
20
21     ! ...   G vectors less than the wave function cut-off ( ecutwfc )
22     INTEGER :: ngw  = 0  ! local number of G vectors
23     INTEGER :: ngw_g= 0  ! in parallel execution global number of G vectors,
24                       ! in serial execution this is equal to ngw
25     INTEGER :: ngwx = 0  ! maximum local number of G vectors
26
27     REAL(DP) :: ecutwfc = 0.0_DP
28     REAL(DP) :: gcutw = 0.0_DP
29
30     !   values for costant cut-off computations
31
32     REAL(DP) :: ecfixed=0.0_DP     ! value of the constant cut-off
33     REAL(DP) :: qcutz = 0.0_DP     ! height of the penalty function (above ecfix)
34     REAL(DP) :: q2sigma=0.0_DP     ! spread of the penalty function around ecfix
35     ! augmented cut-off for k-point calculation
36
37     REAL(DP) :: ekcut = 0.0_DP
38     REAL(DP) :: gkcut = 0.0_DP
39
40     ! array of G vectors module plus penalty function for constant cut-off
41     ! simulation.
42     ! g2kin = g + ( agg / tpiba**2 ) * ( 1 + erf( ( tpiba2*g - e0gg ) / sgg ) )
43
44     REAL(DP), ALLOCATABLE :: g2kin(:)
45
46   CONTAINS
47
48     SUBROUTINE gvecw_init( ngw_ , comm )
49       !
50       USE mp, ONLY: mp_max, mp_sum
51       IMPLICIT NONE
52       INTEGER, INTENT(IN) :: ngw_
53       INTEGER, INTENT(IN) :: comm
54       !
55       ngw = ngw_
56       !
57       !  calculate maximum over all processors
58       !
59       ngwx = ngw
60       CALL mp_max( ngwx, comm )
61       !
62       !  calculate sum over all processors
63       !
64       ngw_g = ngw
65       CALL mp_sum( ngw_g, comm )
66       !
67       !  allocate kinetic energy
68       !
69       ALLOCATE( g2kin(ngw) )
70       !
71       RETURN
72
73     END SUBROUTINE gvecw_init
74
75     SUBROUTINE g2kin_init( gg, tpiba2 )
76       !
77       IMPLICIT NONE
78       REAL(DP), INTENT(IN) :: gg(:), tpiba2
79       REAL(DP), EXTERNAL :: qe_erf
80       REAL(DP) :: gcutz
81       INTEGER :: ig
82       !
83       !  initialize kinetic energy
84       !
85       gcutz  = qcutz / tpiba2
86       IF( gcutz > 0.0d0 ) THEN
87          DO ig=1,ngw
88             g2kin(ig) = gg(ig) + gcutz * &
89                     ( 1.0d0 + qe_erf( ( tpiba2 *gg(ig) - ecfixed )/q2sigma ) )
90          ENDDO
91       ELSE
92          g2kin( 1 : ngw ) = gg( 1 : ngw )
93       END IF
94
95       RETURN
96
97     END SUBROUTINE g2kin_init
98
99     SUBROUTINE deallocate_gvecw
100       IF( ALLOCATED( g2kin ) ) DEALLOCATE( g2kin )
101     END SUBROUTINE deallocate_gvecw
102
103!=----------------------------------------------------------------------------=!
104   END MODULE gvecw
105!=----------------------------------------------------------------------------=!
106