1!
2! Copyright (C) 2001-2012 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_nlpot
11  !-----------------------------------------------------------------------
12  !! This routine allocates arrays containing the non-local part of the
13  !! pseudopotential for each atom or atomic species.
14  !
15  !! Requires in input:
16  !! * dimensions: nhm, nsp, nat, lmaxkb, nbetam, nspin
17  !! * pseudopot info: upf%nwfc
18  !! * parameters: ecutrho, qnorm, dq, ecutwfc, cell_factor
19  !! * options: tqr, noncolin, lspinorb, spline_ps
20  !
21  !! Computes the following global quantities:
22  !! * nqx: number of points of the interpolation table
23  !! * nqxq: as above, for q-function interpolation table
24  !
25  USE control_flags,    ONLY : tqr
26  USE ions_base,        ONLY : nat, nsp
27  USE cellmd,           ONLY : cell_factor
28  USE klist,            ONLY : qnorm
29  USE lsda_mod,         ONLY : nspin
30  USE noncollin_module, ONLY : noncolin
31  USE gvect,            ONLY : ecutrho
32  USE gvecw,            ONLY : ecutwfc
33  USE us,               ONLY : qrad, tab, tab_d2y, tab_at, dq, nqx, &
34                               nqxq, spline_ps
35  USE uspp,             ONLY : indv, nhtol, nhtolm, ijtoh, qq_at, qq_nt, &
36                               dvan, deeq, indv_ijkb0, okvan, nhtoj, &
37                               becsum, ebecsum, qq_so, dvan_so, deeq_nc
38  USE uspp_param,       ONLY : upf, lmaxq, lmaxkb, nh, nhm, nbetam
39  USE spin_orb,         ONLY : lspinorb, fcoef
40  !
41  IMPLICIT NONE
42  !
43  INTEGER :: nwfcm
44  !
45  ! Note: computation of the number of beta functions for
46  ! each atomic type and the maximum number of beta functions
47  ! and the number of beta functions of the solid has been
48  ! moved to init_run.f90 : pre_init()
49  !
50  ALLOCATE( indv(nhm,nsp)   )
51  ALLOCATE( nhtol(nhm,nsp)  )
52  ALLOCATE( nhtolm(nhm,nsp) )
53  ALLOCATE( nhtoj(nhm,nsp)  )
54  ALLOCATE( ijtoh(nhm,nhm,nsp) )
55  ALLOCATE( indv_ijkb0(nat)    )
56  ALLOCATE( deeq(nhm,nhm,nat,nspin) )
57  IF ( noncolin ) THEN
58     ALLOCATE( deeq_nc(nhm,nhm,nat,nspin) )
59  ENDIF
60  ALLOCATE( qq_at(nhm,nhm,nat) )
61  ALLOCATE( qq_nt(nhm,nhm,nsp) )
62  IF ( lspinorb ) THEN
63    ALLOCATE( qq_so(nhm,nhm,4,nsp)       )
64    ALLOCATE( dvan_so(nhm,nhm,nspin,nsp) )
65    ALLOCATE( fcoef(nhm,nhm,2,2,nsp)     )
66  ELSE
67    ALLOCATE( dvan(nhm,nhm,nsp) )
68  ENDIF
69  ! GIPAW needs a slighly larger q-space interpolation for quantities calculated
70  ! at k+q_gipaw, and I'm using the spline_ps=.true. flag to signal that
71  IF ( spline_ps .AND. cell_factor <= 1.1d0 ) cell_factor = 1.1d0
72  !
73  ! This routine is called also by the phonon code, in which case it should
74  ! allocate an array that includes q+G vectors up to |q+G|_max <= |Gmax|+|q|
75  !
76  nqxq = INT( ( (SQRT(ecutrho) + qnorm) / dq + 4) * cell_factor )
77  lmaxq = 2*lmaxkb+1
78  !
79  IF (lmaxq > 0) ALLOCATE (qrad( nqxq, nbetam*(nbetam+1)/2, lmaxq, nsp))
80  ALLOCATE (becsum( nhm * (nhm + 1)/2, nat, nspin))
81  if (tqr) ALLOCATE (ebecsum( nhm * (nhm + 1)/2, nat, nspin))
82  !
83  ! Calculate dimensions for array tab (including a possible factor
84  ! coming from cell contraction during variable cell relaxation/MD)
85  !
86  nqx = INT( (SQRT(ecutwfc) / dq + 4) * cell_factor )
87  !
88  ALLOCATE( tab(nqx,nbetam,nsp) )
89  !
90  ! d2y is for the cubic splines
91  IF (spline_ps) ALLOCATE( tab_d2y(nqx,nbetam,nsp) )
92  !
93  nwfcm = MAXVAL( upf(1:nsp)%nwfc )
94  ALLOCATE( tab_at(nqx,nwfcm,nsp) )
95  !
96  RETURN
97  !
98END SUBROUTINE allocate_nlpot
99