1!
2! Copyright (C) 2010-2013 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!
8SUBROUTINE add_vhub_to_deeq( deeq )
9!-----------------------------------------------------------------
10  !! Add Hubbard contributions to the integral of V_eff and Q_{nm} when
11  !! U_projection is pseudo.
12  !
13  USE kinds,         ONLY : DP
14  USE ions_base,     ONLY : nat, ntyp => nsp, ityp
15  USE uspp_param,    ONLY : nh, nhm
16  USE lsda_mod,      ONLY : nspin
17  USE scf,           ONLY : v
18  USE ldaU,          ONLY : is_hubbard, Hubbard_l, offsetU, q_ae
19  !
20  IMPLICIT NONE
21  !
22  REAL(KIND=DP), INTENT(INOUT) :: deeq( nhm, nhm, nat, nspin )
23  !! integral of V_eff and Q_{nm}
24  !
25  !  ... local variables
26  !
27  INTEGER :: na, nt, ih, jh, ijh, m1, m2, ow1, ow2
28  !
29  !
30  DO na = 1, nat
31     !
32     nt = ityp(na)
33     !
34     ! skip atoms without Hubbard U
35     IF ( .NOT. is_hubbard(nt) ) CYCLE
36     !
37     DO ih = 1, nh(nt)
38        DO jh = ih, nh(nt)
39           !
40           DO m1 = 1, 2 * Hubbard_l(nt) + 1
41              DO m2 = 1, 2 * Hubbard_l(nt) + 1
42                 !
43                 ow1 = offsetU(na)+m1
44                 ow2 = offsetU(na)+m2
45                 deeq(ih,jh,na,1:nspin) = deeq(ih,jh,na,1:nspin) + &
46                    v%ns(m1,m2,1:nspin,na)*q_ae(ow1,ih,na)*q_ae(ow2,jh,na)
47                 !
48              ENDDO
49           ENDDO
50           !
51           deeq(jh,ih,na,1:nspin) = deeq(ih,jh,na,1:nspin)
52           !
53        ENDDO
54     ENDDO
55     !
56  ENDDO
57  !
58END SUBROUTINE add_vhub_to_deeq
59