1!
2! Copyright (C) 2001-2008 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!----------------------------------------------------------------------------
10SUBROUTINE allocate_wfc()
11  !----------------------------------------------------------------------------
12  !! Dynamical allocation of arrays: wavefunctions.
13  !! Requires dimensions: \(\text{npwx}\), \(\text{nbnd}\), \(\text{npol}\),
14  !! \(\text{natomwfc}\), \(\text{nwfcU}\).
15  !
16  USE io_global,           ONLY : stdout
17  USE wvfct,               ONLY : npwx, nbnd
18  USE basis,               ONLY : natomwfc, swfcatom
19  USE fixed_occ,           ONLY : one_atom_occupations
20  USE ldaU,                ONLY : wfcU, nwfcU, lda_plus_u, U_projection
21  USE noncollin_module,    ONLY : npol
22  USE wavefunctions,       ONLY : evc
23  USE wannier_new,         ONLY : use_wannier
24  !
25  IMPLICIT NONE
26  !
27  !
28  ALLOCATE( evc(npwx*npol,nbnd) )
29  IF ( one_atom_occupations .OR. use_wannier ) &
30     ALLOCATE( swfcatom(npwx*npol,natomwfc) )
31  IF ( lda_plus_u .AND. (U_projection.NE.'pseudo') ) &
32       ALLOCATE( wfcU(npwx*npol,nwfcU) )
33  !
34  RETURN
35  !
36END SUBROUTINE allocate_wfc
37!
38!
39!----------------------------------------------------------------------------
40SUBROUTINE allocate_wfc_k()
41  !----------------------------------------------------------------------------
42  !! Dynamical allocation of k-point-dependent arrays: wavefunctions, betas
43  !! kinetic energy, k+G indices. Computes max no. of plane waves \(\text{npwx}\)
44  !! and k+G indices \(\text{igk_k}\) (needs G-vectors and cutoff \(\text{gcutw}\)).
45  !! Requires dimensions \(\text{nbnd}\), \(\text{npol}\), \(\text{natomwfc}\),
46  !! \(\text{nwfcU}\).
47  !! Requires that k-points are set up and distributed (if parallelized).
48  !
49  USE wvfct,            ONLY : npwx, g2kin
50  USE uspp,             ONLY : vkb, nkb
51  USE gvecw,            ONLY : gcutw
52  USE gvect,            ONLY : ngm, g
53  USE klist,            ONLY : xk, nks, init_igk
54  !
55  IMPLICIT NONE
56  !
57  INTEGER, EXTERNAL :: n_plane_waves
58  !
59  !   calculate number of PWs for all kpoints
60  !
61  npwx = n_plane_waves( gcutw, nks, xk, g, ngm )
62  !
63  !   compute indices j=igk(i) such that (k+G)_i = k+G_j, for all k
64  !   compute number of plane waves ngk(ik) as well
65  !
66  CALL init_igk( npwx, ngm, g, gcutw )
67  !
68  CALL allocate_wfc()
69  !
70  !   beta functions
71  !
72  ALLOCATE( vkb(npwx,nkb) )
73  !
74  !   g2kin contains the kinetic energy \hbar^2(k+G)^2/2m
75  !
76  ALLOCATE( g2kin(npwx) )
77  !
78  RETURN
79  !
80END SUBROUTINE allocate_wfc_k
81