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