1! Copyright (C) 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_init(hwwa)
12  !----------------------------------------------------------------------
13  !
14  ! ... This routine ALLOCATEs all dynamically ALLOCATEd arrays for wannier calc
15  !
16  USE wannier_new
17  USE wvfct, only : nbnd, npwx
18  USE input_parameters, only: constrain_pot, wan_data
19  USE lsda_mod, only: nspin
20  USE ions_base, only : nat
21  USE basis, only : natomwfc, swfcatom
22  USE constants, only: rytoev
23  USE klist, only: nks
24  USE io_files
25  USE buffers
26  USE noncollin_module, ONLY : npol
27
28  IMPLICIT NONE
29
30  LOGICAL,INTENT(IN) :: hwwa ! have we Wannier already?
31  LOGICAL :: exst = .FALSE.,opnd
32  INTEGER :: i, io_level
33
34  ALLOCATE(pp(nwan,nbnd))
35  ALLOCATE(wan_in(nwan,nspin))
36  ALLOCATE(wannier_energy(nwan,nspin))
37  ALLOCATE(wannier_occ(nwan,nwan,nspin))
38  ALLOCATE(coef(natomwfc,nwan,nspin))
39
40  coef = ZERO
41  wannier_energy = ZERO
42  wannier_occ = ZERO
43
44  wan_in(1:nwan,1:nspin) = wan_data(1:nwan,1:nspin)
45
46  IF(.NOT. hwwa) THEN
47
48     IF(use_energy_int) THEN
49        do i=1,nwan
50           wan_in(i,:)%bands_from = (1.d0/rytoev)*wan_in(i,:)%bands_from
51           wan_in(i,:)%bands_to = (1.d0/rytoev)*wan_in(i,:)%bands_to
52        end do
53     END IF
54
55     CALL wannier_check()
56  end if
57
58  ALLOCATE(wan_pot(nwan,nspin))
59  wan_pot(1:nwan,1:nspin) = constrain_pot(1:nwan,1:nspin)
60
61  !now open files to store projectors and wannier functions
62  nwordwpp = nwan*nbnd*npol
63  nwordwf = nwan*npwx*npol
64  io_level = 1
65  CALL open_buffer( iunwpp, 'wproj', nwordwpp, io_level, exst )
66  CALL open_buffer( iunwf, 'wwf', nwordwf, io_level, exst )
67
68  ! For atomic wavefunctions
69
70  IF(.NOT. ALLOCATED(swfcatom)) ALLOCATE( swfcatom( npwx, natomwfc))
71
72  nwordatwfc = npwx*natomwfc*npol
73  INQUIRE( UNIT = iunsat, OPENED = opnd )
74  IF(.NOT. opnd) CALL open_buffer( iunsat,'satwfc',nwordatwfc,io_level,exst )
75
76  RETURN
77  !
78END SUBROUTINE wannier_init
79