1!
2! Copyright (C) 2001-2010 Quantum ESPRESSO 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_fft
11  !-----------------------------------------------------------------------
12  !! This routine allocates memory for FFT-related arrays.
13  !! IMPORTANT:  routine "data_structure" must be called before it in
14  !! order to set the proper dimensions and grid distribution across
15  !! processors these dimensions.
16  !
17  USE io_global,        ONLY : stdout
18  USE gvect,            ONLY : ngm, g, gg, mill, igtongl
19  USE gvecs,            ONLY : ngms
20  USE fft_base,         ONLY : dfftp, dffts
21  USE ions_base,        ONLY : nat
22  USE lsda_mod,         ONLY : nspin
23  USE scf,              ONLY : rho, v, vnew, vltot, vrs, rho_core, rhog_core, &
24                               kedtau, create_scf_type
25  USE control_flags,    ONLY : gamma_only
26  USE noncollin_module, ONLY : pointlist, factlist, report, noncolin, npol
27  USE wavefunctions,    ONLY : psic, psic_nc
28  USE funct,            ONLY : dft_is_meta
29  !
30  IMPLICIT NONE
31  !
32  ! ... First a bunch of checks
33  !
34  IF (dfftp%nnr < ngm) THEN
35     WRITE( stdout, '(/,4x," nr1=",i4," nr2= ", i4, " nr3=",i4, &
36          &" nrxx = ",i8," ngm=",i8)') dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nnr, ngm
37     CALL errore( 'allocate_fft', 'the nr"s are too small!', 1 )
38  !
39  ENDIF
40  !
41  IF (dffts%nnr < ngms) THEN
42     WRITE( stdout, '(/,4x," nr1s=",i4," nr2s= ", i4, " nr3s=",i4, &
43          &" nrxxs = ",i8," ngms=",i8)') dffts%nr1, dffts%nr2, dffts%nr3, dffts%nnr, ngms
44     CALL errore( 'allocate_fft', 'the nrs"s are too small!', 1 )
45  ENDIF
46  !
47  IF (ngm  <= 0)      CALL errore( 'allocate_fft', 'wrong ngm' , 1 )
48  IF (ngms <= 0)      CALL errore( 'allocate_fft', 'wrong ngms', 1 )
49  IF (dfftp%nnr <= 0) CALL errore( 'allocate_fft', 'wrong nnr',  1 )
50  IF (dffts%nnr<= 0)  CALL errore( 'allocate_fft', 'wrong smooth nnr', 1 )
51  IF (nspin<= 0)      CALL errore( 'allocate_fft', 'wrong nspin', 1 )
52  !
53  ! ... Allocate memory for all kind of stuff.
54  !
55  CALL create_scf_type( rho )
56  CALL create_scf_type( v,    do_not_allocate_becsum = .TRUE. )
57  CALL create_scf_type( vnew, do_not_allocate_becsum = .TRUE. )
58  !
59  ALLOCATE( vltot(dfftp%nnr) )
60  ALLOCATE( rho_core(dfftp%nnr) )
61  IF ( dft_is_meta() ) THEN
62     ALLOCATE( kedtau(dffts%nnr,nspin) )
63  ELSE
64     ALLOCATE( kedtau(1,nspin) )
65  ENDIF
66  ALLOCATE( rhog_core(ngm)  )
67  ALLOCATE( psic(dfftp%nnr) )
68  ALLOCATE( vrs(dfftp%nnr,nspin) )
69  !
70  IF (noncolin) ALLOCATE( psic_nc(dfftp%nnr,npol) )
71  !
72  IF ( report /= 0 ) THEN
73     !
74     ! ... In order to print out local quantities, integrated around the atoms,
75     ! we need the following variables
76     !
77     ALLOCATE( pointlist(dfftp%nnr) )
78     ALLOCATE( factlist(dfftp%nnr)  )
79     !
80  ENDIF
81  !
82  RETURN
83  !
84END SUBROUTINE allocate_fft
85