1! Copyright (C) 2006-2008 Dmitry Korotin dmitry@korotin.name
2! This file is distributed under the terms of the
3! GNU General Public License. See the file `License'
4! in the root directory of the present distribution,
5! or http://www.gnu.org/copyleft/gpl.txt .
6!
7#define ZERO (0.d0,0.d0)
8#define ONE (1.d0,0.d0)
9!
10!----------------------------------------------------------------------
11SUBROUTINE wannier_occupancies( occ )
12  !----------------------------------------------------------------------
13  !! This routine computes occupation of each wannier. It is assumed that
14  !! WF generated already and stored if the buffer.
15  !
16  USE kinds,        ONLY: DP
17  USE wannier_new,  ONLY: nwan, pp
18  USE io_global,    ONLY: stdout
19  USE wvfct,        ONLY: nbnd, et, wg
20  USE klist,        ONLY: nks
21  USE lsda_mod,     ONLY: current_spin, lsda, nspin, isk
22  USE io_files
23  USE buffers
24  !
25  IMPLICIT NONE
26  !
27  REAL(DP), INTENT(OUT) :: occ(nwan, nwan, nspin)
28  !! the occupation of each wannier
29  !
30  ! ... local variables
31  !
32  INTEGER :: i,j,k,ik
33  !
34  occ = ZERO
35  current_spin = 1
36  !
37  DO ik = 1, nks
38     IF (lsda) current_spin  = isk(ik)
39     CALL get_buffer( pp, nwordwpp, iunwpp, ik)
40     DO i = 1, nwan
41        DO j = 1,nwan
42           DO k = 1, nbnd
43              occ(i,j,current_spin) = occ(i,j,current_spin) + pp(i,k) * &
44                                                      CONJG(pp(j,k))*wg(k,ik)
45           END DO
46        END DO
47     END DO
48  END DO
49  !
50  IF (nspin==1) occ = occ * 0.5_DP
51  !
52  RETURN
53  !
54END SUBROUTINE wannier_occupancies
55!
56