1!
2! Copyright (C) 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!
9SUBROUTINE add_paw_to_deeq( deeq )
10  !
11  !! Add paw contributions to the integral of the perturbed potential
12  !! with the Q function (computed in paw_potential).
13  !
14  USE kinds,         ONLY : DP
15  USE ions_base,     ONLY : nat, ntyp => nsp, ityp
16  USE uspp_param,    ONLY : upf, nh, nhm
17  USE paw_variables, ONLY : okpaw, ddd_paw
18  USE lsda_mod,      ONLY : nspin
19  !
20  IMPLICIT NONE
21  !
22  REAL(KIND=DP), INTENT(INOUT) :: deeq( nhm, nhm, nat, nspin )
23  !! integral of the perturbed potential
24  !
25  ! ... local variables
26  !
27  INTEGER :: na, nt, ih, jh, ijh
28  !
29  IF (okpaw) THEN
30     DO na=1,nat
31        nt = ityp(na)
32        IF (.not.upf(nt)%tpawp) CYCLE
33        ijh=0
34        DO ih=1,nh(nt)
35           DO jh=ih,nh(nt)
36              ijh=ijh+1
37              deeq(ih,jh,na,1:nspin) = deeq(ih,jh,na,1:nspin) + &
38                                        ddd_paw(ijh,na,1:nspin)
39              deeq(jh,ih,na,1:nspin) = deeq(ih,jh,na,1:nspin)
40           ENDDO
41        ENDDO
42     ENDDO
43  ENDIF
44  !
45  RETURN
46  !
47END SUBROUTINE add_paw_to_deeq
48