1!
2! Copyright (C) 2001-2003 PWSCF 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!-----------------------------------------------------------------------
10FUNCTION sumkg( et, nbnd, nks, wk, degauss, ngauss, e, is, isk )
11  !-----------------------------------------------------------------------
12  !! This function computes the number of states under a given
13  !! energy \( e \).
14  !
15  USE kinds
16  USE mp_pools,  ONLY: inter_pool_comm
17  USE mp,        ONLY: mp_sum
18  !
19  IMPLICIT NONE
20  !
21  REAL(DP) :: sumkg
22  !! output:
23  INTEGER, INTENT(IN) :: nks
24  !! the total number of K points
25  INTEGER, INTENT(IN) :: nbnd
26  !! the number of bands
27  INTEGER, INTENT(IN) :: ngauss
28  !! the type of smearing
29  REAL(DP), INTENT(IN) :: wk(nks)
30  !! the weight of the k points
31  REAL(DP), INTENT(IN) :: et(nbnd,nks)
32  !! the energy eigenvalues
33  REAL(DP), INTENT(IN) :: degauss
34  !! gaussian broadening
35  REAL(DP), INTENT(IN) :: e
36  !! the energy to check
37  INTEGER, INTENT(IN) :: is
38  !! the spin label
39  INTEGER, INTENT(IN) :: isk(nks)
40  !! the spin index for each k-point
41  !
42  ! ... local variables
43  !
44  REAL(DP), EXTERNAL :: wgauss
45  ! function which compute the smearing
46  REAL(DP) :: sum1
47  INTEGER :: ik, ibnd
48  ! counter on k points
49  ! counter on the band energy
50  !
51  !
52  sumkg = 0.d0
53  !
54  DO ik = 1, nks
55     !
56     sum1 = 0.d0
57     IF (is /= 0) THEN
58        IF (isk(ik) /= is) CYCLE
59     ENDIF
60     DO ibnd = 1, nbnd
61        sum1 = sum1 + wgauss( (e-et(ibnd,ik))/degauss, ngauss )
62     ENDDO
63     sumkg = sumkg + wk (ik) * sum1
64     !
65  ENDDO
66  !
67#if defined(__MPI)
68  CALL mp_sum( sumkg, inter_pool_comm )
69#endif
70  !
71  RETURN
72  !
73END FUNCTION sumkg
74
75