1!
2! Copyright (C) 2011-2014 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!-------------------------------------------------------------------------
9MODULE ldaU_cp
10!-------------------------------------------------------------------------
11  USE parameters, ONLY: nsx
12  USE kinds
13  implicit none
14  save
15  real(DP) :: Hubbard_U(nsx)
16  real(DP) :: e_hubbard = 0.d0
17  real(DP), allocatable :: ns(:,:,:,:)
18  integer :: Hubbard_l(nsx), Hubbard_lmax=0, ldmx=0, nwfcU
19  logical :: lda_plus_u
20  COMPLEX(DP), allocatable::  vupsi(:,:)
21  !
22contains
23  !
24  subroutine ldaU_init0 ( nsp, lda_plus_u_, Hubbard_U_ )
25!-----------------------------------------------------------------------
26!
27      USE constants,        ONLY: autoev
28      !
29      IMPLICIT NONE
30      INTEGER, INTENT(IN) :: nsp
31      LOGICAL, INTENT(IN) :: lda_plus_u_
32      REAL(DP),INTENT(IN) :: Hubbard_U_(nsp)
33
34      lda_plus_u = lda_plus_u_
35      Hubbard_U(1:nsp) = Hubbard_U_(1:nsp) / autoev
36      !
37  END SUBROUTINE ldaU_init0
38  !
39  subroutine deallocate_lda_plus_u()
40     !
41     IF( ALLOCATED( ns ) ) DEALLOCATE( ns )
42     IF( ALLOCATED( vupsi ) ) DEALLOCATE( vupsi )
43     !
44     !
45  end subroutine
46  !
47end module ldaU_cp
48